求一个LISP程序，现在小弟只有1个明经币，给不了多少悬赏，希望有好心的老师帮忙写段
希望有段程序可以自动完成，如图1转成图2的程序， 首先：选择要将双线转为单线的对象 然后：输入两条线之间的模糊间距，执行完以后将封闭的对象（如图1） 转成单线（如图2），如有哪位好心的老师，希望可以帮小弟编写一个程序的源码，本人感激不尽！Try ...
(defun Line2-1 (sset)
(setq pts (acet-geom-ss-extents sset nil) ; ET needed
xx1 (caar pts)
xx2 (caadr pts)
yy5 (/ (+ (cadar pts) (cadadr pts)) 2)
pt1 (list xx1 yy5)
pt2 (list xx2 yy5)
)
(command "erase" sset "")
(entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2)))
)
(defun AC2-1 (sset)
(setq ee1 (ssname sset 0)
ee2 (ssname sset 1)
rr1 (cdr (assoc 40 (entget ee1)))
dat (entget ee2)
rrr (assoc 40 dat)
rr2 (/ (+ rr1 (cdr rrr)) 2)
)
(entmod (subst (cons 40 rr2) rrr dat))
(command "erase" ss "r"ee2 "")
)
(defun C:test ()
(setq ss (ssget '((0 . "Arc,Circle,Line")))
nn (sslength ss)
)
(cond
((> nn 2)
(cond
((setq ssa (ssget "P" '((0 . "Arc"))))
(AC2-1 ssa)
)
((= nn 4) ; Lines
(Line2-1 ss)
)))
(T ; Circle
(AC2-1 ss)
))
)
最好上个cad图给别人测试！ 老师 测试图已经上传 Andyhon 发表于 2013-1-14 20:21 static/image/common/back.gif
Try ...
谢谢，Andyhon老师，这个程序正是我想要的 Andyhon 发表于 2013-1-14 14:36 static/image/common/back.gif
Try ...
老师，这个用了哪个版本的通用函数，我想修改下，可以窗选好多对象，把其都变成单线，如果老师有空，是否可以帮我改下 Acet-* 函数; ET needed
Express Tools 详站内老帖
页:
[1]