代码改变世界

AutoLISP引线序号球

2011-04-05 11:00  精诚所至 金石为开  阅读(489)  评论(0编辑  收藏  举报

AutoLISP引线序号球,代码如下。

(defun c:test ()
    (setvar "cmdecho" 0)
    (setq old_rr (getvar "circlerad"))
    (setq str_rr (strcat "\n圆半径<" (rtos old_rr 2) ">:"))
    (setq rr1 (getdist str_rr))
    (if    (null rr1)
    (setq rr1 old_rr)
    )
    (setq num (getint "\n起始值<1>:"))
    (if    (= num nil)
    (setq num 1)
    )
    (setq dd2 (/ rr1 2.5))
    (setq pt1 (getpoint "\n起点:"))
    (command "donut" 0 dd2 pt1 "")
    (setq pt2 (getpoint pt1 "\n下一点:"))
    (while pt2
    (setq ang (angle pt1 pt2))
    (setq dd (distance pt1 pt2))
    (setq cen (polar pt1 ang (/ dd 2)))
    (command "line" pt1 pt2 "")
    (setq en1 (entlast))
    (command "circle" cen rr1)
    (command "trim" (entlast) "" (list en1 cen) "")
    (command "text" "m" cen rr1 (* (/ ang pi) 180) (itoa num))
    (command "donut" 0 dd2 pt2 "")
    (setq num (1+ num)
          pt1 pt2
          pt2 ""
    )
    (setq pt2 (getpoint pt1 "\n下一点:"))
    )
    (prin1)
)

代码完。

刚买的鼠标前天被摔坏了,滚轮不能用了,CAD放大缩小很不方便,看来得再买一个。