代码改变世界

AutoLISP添加正方形编号

2011-03-28 16:48  精诚所至 金石为开  阅读(480)  评论(0编辑  收藏  举报

AutoLISP添加正方形编号,代码如下。

(defun c:test()
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq dd (getdist "\n正方形边长<10>:"))
  (if (null dd) (setq dd 10))
  (setq num (getint "\n起始编号<1>:"))
  (if (null num) (setq num 1))
  (setq dd2 (/ dd 5))
  (setq pt1 (getpoint "\n第一点:"))
  (while (/= pt1 nil)
    (command "donut" 0 dd2 pt1 "")
    (setq pt2 (getpoint pt1 "\n第二点:"))
    (command "line" pt1 pt2 "")
    (command "polygon" 4 "e" pt2 (polar pt2 0 dd))
    (setq en1 (entlast))
    (command "text" "m" (polar (polar pt2 0 (/ dd 2)) (/ pi 2) (/ dd 2)) (/ dd 2) 0 (itoa num))
    (setq en2 (entlast))
    (setq pp1 pt2)
    (setq pp2 (polar pp1 0 dd))
    (setq pp3 (polar pp2 (/ pi 2) dd))
    (setq pp4 (polar pp1 (/ pi 2) dd))
    (setq pp_0 (polar pp1 (/ pi 2) (/ dd 2)))
    (setq pp_90 (polar pp1 0 (/ dd 2)))
    (setq pp_180 (polar pp2 (/ pi 2) (/ dd 2)))
    (setq pp_270 (polar pp3 pi (/ dd 2)))
    (setq pp pt2)
    (setq ang (angle pt1 pt2))
    (cond ((and (> ang (* pi 0.5)) (< ang pi)) (setq pp pp2))
      ((and (> ang pi) (< ang (* pi 1.5))) (setq pp pp3))
      ((and (> ang (* pi 1.5)) (< ang (* pi 2))) (setq pp pp4))
      )
    (cond ((= ang 0) (setq pp pp_0))
      ((= ang (/ pi 2)) (setq pp PP_90))
      ((= ang pi) (setq pp pp_180))
      ((= ang (* pi 1.5)) (setq pp pp_270))
      )
    (command "move" en1 en2 "" pp pt2)
    (setq num (1+ num))
    (setq pt1 (getpoint "\n第一点:"))
    )
  (setvar "osmode" os)
  (prin1)
  )

代码完。

总是第一点第二点的循环,没有编号。