AutoLISP绘制砖墙
2011-03-28 20:05 精诚所至 金石为开 阅读(371) 评论(0) 编辑 收藏 举报AutoLISP自动绘制砖墙,代码如下。
(defun c:test()
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setq oldclayer (getvar "clayer"))
(setvar "osmode" 0)
(command "undo" "be")
(setq pt1 (getpoint "砖墙左下角基准点:"))
(setq w (getdist pt1 "\n宽度<95>:")) (if (null w) (setq w 95))
(setq h (getdist pt1 "\n高度<55>:")) (if (null h) (setq h 55))
(setq m (getint "\n垂直方向等分数---<5>:")) (if (null m) (setq m 5))
(setq n (getint "\n水平方向等分数|||<6>:")) (if (null n) (setq n 6))
(command "-layer" "m" "str" "c" 4 "" "")
(setq pt3 (polar (polar pt1 0 w) (/ pi 2) h))
(command "rectang" pt1 pt3)
(setq gap_w (/ w n) gap_h (/ h m))
(setq i 1 pa pt1 pb pt1)
(repeat m
(setq pa (polar pa (/ pi 2) gap_h))
(if (/= i m) (command "line" pa (polar pa 0 w) ""))
(if (= (rem i 2) 1)
(progn
(setq pb (polar pa 0 gap_w))
(command "line" pb (polar pb (* pi 1.5) gap_h) "")
(command "array" (entlast) "" "r" 1 (1- n) gap_w)
)
(progn
(setq pb (polar pa 0 (/ gap_w 2)))
(command "line" pb (polar pb (* pi 1.5) gap_h) "")
(command "array" (entlast) "" "r" 1 n gap_w)
)
)
(setq i (1+ i))
)
(command "-layer" "m" "dim" "c" 1 "" "")
(command "dim1" "ver" pt1 (polar pt1 (/ pi 2) h) (polar pt1 pi 10) "")
(command "dim1" "hor" pt1 (polar pt1 0 w) (polar pt1 (* pi 1.5) 10) "")
(command "undo" "e")
(setvar "osmode" os)
(setvar "clayer" oldclayer)
(prin1)
)
代码完。