求助!画表格的Lisp小程序,不知哪里有错。好人帮我看看啊。
panba
panba Lv.2
2010年11月22日 20:33:54
只看楼主

求助!画表格的Lisp小程序,不知哪里有错。好人帮我看看啊。(defun C:drbg() ;; Draw Biao Ge (setvar "cmdecho" 0) (setq os (getvar"osmode")) (setvar "osmode" 0) (setq pt1 (GetPoint"\n first point for bg: ")) (setq pt3 (GetCorner pt1 "\n second point for bg: "))

求助!画表格的Lisp小程序,不知哪里有错。
好人帮我看看啊。
(defun C:drbg() ;; Draw Biao Ge
(setvar "cmdecho" 0)
(setq os (getvar"osmode"))
(setvar "osmode" 0)
(setq pt1 (GetPoint"\n first point for bg: "))
(setq pt3 (GetCorner pt1 "\n second point for bg: "))
(command "rectang" "w" 1 pt1 pt3)
(setq wnn (+ 1 (getint"\nLie shu ||| <5>: ")))
(if (null wnn) (setq wnn 5))
(setq hnn (+ 1 (getint"\nHang shu --- <5>: ")))
(if (null hnn) (setq hnn 5))
(setq pt2 (list (car pt3) (cadr pt1)))
(setq pt4 (list (car pt1) (cadr pt3)))
(setq ang (angle pt1 pt3))

;;判断所選角度方向、重新調整四個角数値
(cond (and (> ang 0) (< ang (/ pi 2))) (setq pp1 pt1 pp2 pt2 pp3 pt3 pp4 pt4))
((and (> ang (/ pi 2)) (< ang pi)) (setq pp1 pt2 pp2 pt1 pp3 pt4 pp4 pt3))
((and (> ang pi) (< ang (* pi 1.5))) (setq pp1 pt3 pp2 pt4 pp3 pt1 pp4 pt2))
((and (> ang (* pi 1.5)) (< ang (* pi 2))) (setq pp1 pt4 pp2 pt3 pp3 pt2 pp4 pt1))
)

(setq num 1 txt 65)
(setq ww (distance pp1 pp2))
(setq hh (distance pp1 pp4))
(setq pt1 pp4 ppbas pp4 key 1)
(repeat hnn ;;draw hang
(setq pt1 (polar pt1 (* pi 1.5) (/ hh hnn)))
(setq pt2 (polar pt1 0 ww))
(command "line" pt1 pt2 "")
(if (> key 1)
(progn
(setq txtins (inters ppbas (polar pt1 0 (/ ww wnn)) pt1 (polar ppbas 0 (/ ww wnn))))
(command "text" "m" txtins (/ hh hnn 2) 0 (itoa num))
(setq num (+ 1 num))
)
)

(setq ppbas pt1 key (+ 1 key))
)

(setq pt1 pp4 ppbas pp4 key 1)
(repeat wnn ; ;draw lie
(setq pt1(polar pt1 0(/ ww wnn)))
(setq pt2(polar pt1 (* pi 1.5) hh))
(command "line" pt1 pt2 "")
(if (> key 1))
(progn
(setq txtins (inters ppbas (polar pt1 (* pi 1.5) (/ hh hnn)) pt1 (polar ppbas (* pi 1.5) (/ hh hnn))))
(command "text" "m" txtins (/ hh hnn 2) 0 (chr txt))
(setq txt (+ 1 txt))
)
)
(setq ppbas pt1 key (+ 1 key))
)
(princ)
)
免费打赏
panba
2010年11月22日 20:59:09
2楼
-- -------- -------- -------- -------- -------- -------- -------- *
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
* -------- -------- -------- -------- -------- -------- -------- --


--------------- --------------- ------------------------------ ----------- ------------ -------------- ---- --
| | A | B | C |
--------------- --------------- --------------- -------------- --------------- --------------- --------------- -------- --
| 1 | | | |
|-------------- --------------- |--------------- -------- |--------------- -------- |--------------- -------- |
| 2 | | | |
|-------------- --------------- |-------------- -------- |-------------- -------- |--------------- -------- |
| 3 | | | |
|-------------- --------------- |-------------- -------- |------------------------------- |--------------- -------- |
| 4 | | | |
|-------------- --------------- |-------------- -------------- |-------------- -------------- |-------------- -------- |
| 5 | | | |
|--------------- --------------- |------------- --------------- |------------- ----------- |-------------- -------- |
| 6 | | | |
--------------- -------------- --------------- -------------- --------------- ------------- --------------- --------
回复
panba
2010年11月22日 21:01:44
3楼
对不起,怎么会这样,效果太差。但估计表达明了吧。
回复
panba
2010年11月25日 12:03:01
4楼
没人理睬啊。
向百忙之中的大侠们求助啊!。
自己顶一下。
回复
zml84
2010年11月25日 14:36:26
5楼
[code](defun C:drbg ()
(princ "\n功能:绘制表格\tzml84修改于2010-11-25")

(setq pt1 (GetPoint "\n第一点: "))
(setq pt3 (GetCorner pt1 "\n第二点: "))
(command "_.rectang" "w" 1 pt1 pt3)

;;获取行数
(if (setq hnn (getint "\n行数--- <3>: "))
()
(setq hnn 3)
)
(if (setq wnn (getint "\n列数||| <5>: "))
()
(setq wnn 5)
)
;;计算角点
(setq x1 (car pt1)
y1 (cadr pt1)
x3 (car pt3)
y3 (cadr pt3)
)
(setq pt1 (list (min x1 x3) (min y1 y3))
pt2 (list (max x1 x3) (min y1 y3))
pt4 (list (min x1 x3) (max y1 y3))
pt3 (list (max x1 x3) (max y1 y3))
)

(setq w (distance pt1 pt2)
h (distance pt1 pt4)
)

;;绘制横向线
(setq dist (/ h 1.0 hnn)
pt_tmp1 pt1
pt_tmp2 pt2
)
(repeat (1- hnn)
(setq pt_tmp1 (polar pt_tmp1 (* pi 0.5) dist)
pt_tmp2 (polar pt_tmp2 (* pi 0.5) dist)
)
(command "_.line" "non" pt_tmp1 "non" pt_tmp2 "")
)

;;绘制竖向线
(setq dist (/ w 1.0 wnn)
pt_tmp1 pt1
pt_tmp2 pt4
)
(repeat (1- wnn)
(setq pt_tmp1 (polar pt_tmp1 (* pi 0) dist)
pt_tmp2 (polar pt_tmp2 (* pi 0) dist)
)
(command "_.line" "non" pt_tmp1 "non" pt_tmp2 "")
)
)


(princ)[/code]
回复
panba
2010年11月26日 12:59:21
6楼
谢谢zml兄 ,
大恩大德,实在无以为报,
很荣幸留下你的大名在我的工具箱了。
回复
郭小城zweibo
2014年11月14日 09:00:03
7楼
支持下楼主
回复

相关推荐

APP内打开