http://bbs.mjtd.com/forum.php?mod=redirect&goto=findpost&ptid=83780&pid=440101&fromuid=338795;;选择直线相连 By Gu_xl
(defun c:tt(/ gxl-Sel-ReDrawSel gxl-Sel-SSsub gxl-Sel-SSJoin gxl-sel-SSgetLineatPoint getline)
(defun gxl-Sel-ReDrawSel (Sel mode / m n)
(setq m (sslength Sel)
n 0)
(repeat m
(redraw (ssname Sel n) mode)
(setq n (1+ n))
);repeat
)
(defun gxl-Sel-SSsub(ss1 ss2 / ss n)
(cond
((and ss1 ss2)
(setq n 0)
(repeat (sslength ss2)
(ssdel (ssname ss2 n) ss1)
(setq n (1+ n))
)
)
((and ss1 (not ss2))
ss1
)
(T
(setq ss1 nil)
)
)
ss1
)
(defun gxl-Sel-SSJoin ( ss1 ss2 / ename ss cnt )
(if ss1
(progn
(if (= (type ss1) 'ENAME)
(progn
(setq
ename ss1
ss1 (ssadd)
)
(ssadd ename ss1)
))
))
(if ss2
(progn
(if (= (type ss2) 'ENAME)
(progn
(setq
ename ss2
ss2 (ssadd)
)
(ssadd ename ss2)
))
))
(setq ss (ssadd))
(if (and ss1 ss2)
(progn
;(setq ss ss2 cnt 0)
(setqcnt 0)
(repeat (sslength ss2)
(ssadd (ssname ss2 cnt) ss)
(setq cnt (1+ cnt))
)
(setqcnt 0)
(repeat (sslength ss1)
(ssadd (ssname ss1 cnt) ss)
(setq cnt (1+ cnt))
)
))
(if (and ss1 (not ss2))
(setq ss ss1))
(if (and ss2 (not ss1))
(setq ss ss2))
(if (> (sslength ss) 0)
;;(eval ss)
ss
nil
)
)
(defun gxl-sel-SSgetLineatPoint (pt jd /px py px0 px1 py0 py1 sspz)
(setq px (car pt)
px0 (- px jd)
px1 (+ px jd)
py (cadr pt)
py0 (- py jd)
py1 (+ py jd)
pz (caddr pt)
)
(setq ss
(ssget "x" (list '(0 . "line")
'(-4 . "<or")
'(-4 . "<and")
'(-4 . ">=,>=,=")
(list 10 px0 py0 pz)
'(-4 . "<=,<=,=")
(list 10 px1 py1 pz)
'(-4 . "and>")
'(-4 . "<and")
'(-4 . ">=,>=,=")
(list 11 px0 py0 pz)
'(-4 . "<=,<=,=")
(list 11 px1 py1 pz)
'(-4 . "and>")
'(-4 . "or>")
)
)
)
(if ss(GXL-SEL-REDRAWSEL ss 3))
ss
)
(defun getline (pt jd / s s1 n p1 p2)
(setq s (gxl-sel-SSgetLineatPoint pt jd))
(if s
(progn
(setq s1 (GXL-SEL-SSSUB s ssrtl)
ssrtl (GXL-SEL-SSJOIN ssrtl s1)
)
(if s1
(progn
(setq n 0)
(repeat (sslength s1)
(setq p1 (cdr (assoc 10 (entget (ssname s1 n))))
p2 (cdr (assoc 11 (entget (ssname s1 n))))
)
(getline p2 jd)
(getline p1 jd)
(setq n (1+ n))
)
)
)
)
)
)
;;;程序开始
(princ "\n选择直线：")
(setq enline (car (entsel)))
(initget 5 "")
(setq jd (getreal "输入容差精度：<0.001>"))
(if (= jd "")(setq jd 0.001))
(setq pt1 (cdr (assoc 10 (entget enline))))
(setq pt2 (cdr (assoc 11 (entget enline))))
(setq ssrtl (ssadd enline))
(getline pt1 jd)
(getline pt2 jd)
(sssetfirst nil ssrtl)
)
G版的程式可以实现。 已OK，但要把多段线改为直线
页:
1
[2]