代码改变世界

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)
  )

代码完。