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放大缩小很不方便,看来得再买一个。