首尾相连的N条直线选中其中任何一条都能选中N条线段如何用lisp实现啊

qcw911 发表于 2010-10-13 15:42:00

大家好
我有一个问题
就是
现在N条首尾相连的线段，需要选择任何一条线段，都可以吧整个N条线段全部选择
lisp如何编写？
拜托大家帮我编写一个lsp
本人初学lisp

qcw911 发表于 2013-3-19 15:10:58

来自： http://zml84.blog.sohu.com/221693089.html

;;;=================================================================*
;;;功能：连接首尾相连线条
;;;操作方式：点取一条，自动搜索相接对象，在分支处提示。
(defun c:xx (/ ss0 ss1 lst_en EN EN_BASE FIL I LET_EN LST LST_0 LST_1
 PT0 PT1 TMP)
(princ "\n功能：连接首尾相连线条")

;;
(or (setq *fuzz* (getdist "\n请输入连接精度<5>: "))
 (setq *fuzz* 5.0)
)
;; 生成首尾相连选集.
(if (and (setq fil '((0 . "LINE,ARC,*POLYLINE")))
 (setq ss0 (ssget "x" fil))
 (princ "\n请点取一条线：")
 (setq ss1 (ssget ":S" fil))
 )
(progn

 ;;1、得到首个对象
 (setq en_base (ssname ss1 0)
 pt0 (vlax-curve-getStartPoint en_base)
 pt1 (vlax-curve-getEndPoint en_base)
 )
 ;;2、获取lst_en
 (setq let_en '()
 i 0
 ss0 (ssdel en_base ss0)
 )
 (repeat (sslength ss0)
(setq en (ssname ss0 i)
 lst_en (cons en lst_en)
 i (1+ i)
)
 )
 ;;3、计算起点处
 (setq lst_0 (xx-find lst_en pt0 *fuzz*))
 ;;4、计算终点处
 (foreach en lst_0
(setq lst_en (vl-remove en lst_en))
 )
 (setq lst_1 (xx-find lst_en pt1 *fuzz*))
 (print lst_0)
 (print lst_1)
 (setq lst (append (reverse lst_0) (list en_base) lst_1))
 ;;4、连接操作
 (command "_.undo" "be")
 (setq tmp (getvar "PEDITACCEPT"))
 (setvar "PEDITACCEPT" 1)

 ;;方式一
 (command "_.pedit" "m" en_base)
 (foreach en (append lst_0 lst_1)
(command en)
 )
 (command "" "j" *fuzz* "")

)
)
(princ)
)
;;;=================================================================*
;;;查找符合要求的图元。 *
;;;要求：首尾相连，允许误差为fuzz。 *
;;;★★特别的：按照坐标差值判断，而不是两点间距计算。 *
(defun xx-find (lst_en pt fuzz / lst_jg en pt0 pt1 tmp pt_next)
(setq lst_jg '())
(foreach en lst_en
(setq pt0 (vlax-curve-getStartPoint en)
 pt1 (vlax-curve-getEndPoint en)
)
(cond ((equal pt0 pt fuzz)
 (setq tmp (list en pt0 pt1)
lst_jg (cons tmp lst_jg)
 )
 )
 ((equal pt1 pt fuzz)
 (setq tmp (list en pt1 pt0)
lst_jg (cons tmp lst_jg)
 )
 )
)
)
;;判断并返回
;;若找到多个，则需要人工干预
(cond ((= lst_jg nil)
nil
)
((= (length lst_jg) 1)
(setq tmp (car lst_jg)
 en (nth 0 tmp)
 pt_next (nth 2 tmp)
 lst_en(vl-remove en lst_en)
)
(cons en (xx-find lst_en pt_next fuzz))
)
((> (length lst_jg) 1)
(setq tmp (xx-sel-only lst_jg)
 en (nth 0 tmp)
 pt_next (nth 2 tmp)
 lst_en(vl-remove en lst_en)
)
(cons en (xx-find lst_en pt_next fuzz))
)
)
)
;;;=================================================================*
;;;提醒用户选择分支中的一个。
;;;参数：lst 格式：'((enpt0pt1)(enpt0pt1)..)
;;;返回：(enpt0pt1)
(defun xx-sel-only (lst / lst_en en pt0 pt1 tmp)
;;移动对象到屏幕中心位置
(command "-pan" (trans (cadar lst) 0 1) (getvar "VIEWCTR"))

;;逐个对象高亮显示
(and ZL-DRAW-GRVECS-CIRCLE
 (progn (ZL-DRAW-GRVECS-CIRCLE (trans (cadar lst) 0 1) 10 1)
 (ZL-DRAW-GRVECS-CIRCLE (trans (cadar lst) 0 1) 15 2)
 )
)
(setq lst_en (mapcar 'car lst))
(mapcar '(lambda (en) (redraw en 3)) lst_en)

;;提示用户选择
(while (not (and (setq tmp (car (entsel "\n点取分支：")))
 (setq tmp (assoc tmp lst))
 )
)
()
)
;;逐个对象取消高亮显示
(mapcar '(lambda (en) (redraw en 4)) lst_en)
;;返回
tmp
)
;;;=================================================================*

Gu_xl 发表于 2010-10-13 23:17:00

还有几个问题要处理，比如相连的直线不在显示窗口内，无法选择出来，还有某一直线端点有多条直线的，要全部选择上，还有点麻烦，需要嵌套循环计算，越搞越复杂了，太晚了，睡觉先！等有空再搞吧！

xyp1964 发表于 2017-11-23 21:29:54

;; ep-sjxz(神经选择)

qcw911 发表于 2010-10-13 20:10:00

没人顶啊？帖子快沉下去了

ZZXXQQ 发表于 2010-10-13 21:25:00

生成相连线条的选择集明经 ZZXXQQ 2010.10.13
(defun c:tt ()
(if (setq pt (getpoint "\n选择线条端点 :"))
(if (setq en (ssget "C" pt pt '((0 . "LINE")))) (progn
(setq enq (ssname en 0)
      ent (entget en1)
      p1 (cdr(assoc 10 ent))
      p2 (cdr(assoc 11 ent)))
(if (equal (distance p2 pt) 0.0 0.001)
(setq p1 p2 p2 (cdr(assoc 10 ent)))
)
(setq ss (ssadd en1 ss))
(while (> (sslength(setq s1 (ssget "C" p2 p2 '((0 . "LINE"))))) 1)
(setq s1 (ssdel en1 s1))
(setq en1 (ssname s1 0)
      ent (entget en1)
      p1 (cdr(assoc 10 ent)))
(if (equal (distance p1 p2) 0.0 0.001)
(setq p2 (cdr(assoc 11 ent)))
(setq p2 p1)
)
(setq ss (ssadd en1 ss))
)
))
)
ss
)

Gu_xl 发表于 2010-10-13 23:08:00

赞一下ZZXXQQ版主，好思路！修正程序中几个小错误，并加以改进，直接选取直线，并亮显选择的直线：

(defun c:tt ()

(princ "\n选择直线：")
(setq enline (car (entsel)))
(setq ss (ssadd enline))
(setq pt (cdr (assoc 10 (entget enline))))
(setq pt1 (cdr (assoc 11 (entget enline))))
(if (setq en (ssget "C" pt pt1 '((0 . "LINE"))))
(progn
 (setq n 0)
 (while (and (< n (sslength en))(ssmemb (setq en1 (ssname en n)) ss)) (setq n (1+ n)))
(setq ent (entget en1)
 p1 (cdr(assoc 10 ent))
 p2 (cdr(assoc 11 ent)))
(if (equal (distance p2 pt) 0.0 0.001)
(setq p1 p2 p2 (cdr(assoc 10 ent)))
)
(setq ss (ssadd en1 ss))
(while (> (sslength(setq s1 (ssget "C" p2 p2 '((0 . "LINE"))))) 1)
(setq s1 (ssdel en1 s1))
(setq en1 (ssname s1 0)
 ent (entget en1)
 p1 (cdr(assoc 10 ent)))
(if (equal (distance p1 p2) 0.0 0.001)
(setq p2 (cdr(assoc 11 ent)))
(setq p2 p1)
)
(setq ss (ssadd en1 ss))
)
))
(if (setq en (ssget "C" pt pt1 '((0 . "LINE"))))
(progn
 (setq n 0)
 (while (and (< n (sslength en))(ssmemb (setq en1 (ssname en n)) ss)) (setq n (1+ n)))
(setq ent (entget en1)
 p1 (cdr(assoc 10 ent))
 p2 (cdr(assoc 11 ent)))
(if (equal (distance p2 pt) 0.0 0.001)
(setq p1 p2 p2 (cdr(assoc 10 ent)))
)
(setq ss (ssadd en1 ss))
(while (> (sslength(setq s1 (ssget "C" p2 p2 '((0 . "LINE"))))) 1)
(setq s1 (ssdel en1 s1))
(setq en1 (ssname s1 0)
 ent (entget en1)
 p1 (cdr(assoc 10 ent)))
(if (equal (distance p1 p2) 0.0 0.001)
(setq p2 (cdr(assoc 11 ent)))
(setq p2 p1)
)
(setq ss (ssadd en1 ss))
)
))
(setq n 0)
(repeat (sslength ss)
(redraw (ssname ss n) 3)
(setq n (1+ n))
)
ss

)

461045462 发表于 2010-10-14 06:44:00

本帖最后由作者于 2010-10-14 7:31:18 编辑 谢谢班主
谢谢Gu_xl
如果POLYLINE线也能选出或许更好，因为现在用POLYLINE作图的较多。
学习了

Gu_xl 发表于 2010-10-14 12:04:00

本帖最后由 Gu_xl 于 2013-3-13 11:04 编辑

Gu_xl发表于2010-10-13 23:17:00http://bbs.mjtd.com/static/image/common/back.gif还有几个问题要处理，比如相连的直线不在显示窗口内，无法选择出来，还有某一直线端点有多条直线的，要全部选择上，还有点麻烦，...
问题解决了！
;;选择直线相连 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)
ssrtl
)

qcw911 发表于 2010-10-14 20:57:00

谢谢 Gu_xl 
谢谢 ZZXXQQ版主
能得到版主的回答很是荣幸

qcw911 发表于 2010-10-14 21:00:00

这个飞诗编写的
我修改了一点点
结合成pl线了
(vl-load-com)
(defun gotonexten (en pt / box en2 en2lst ep i sp ss)
(setq box (* (/ (getvar "pickbox") (cadr (getvar "screensize")))
(getvar "viewsize")
)
)
(setq ss (ssget "c"
 (mapcar '- pt (list box box))
 (mapcar '+ pt (list box box))
)
)
(if ss
(progn
(ssdel en ss)
(setq i 0)
(while (setq en2 (ssname ss i))
(setq i (1+ i))
(setq
sp (vl-catch-all-apply 'vlax-curve-getStartPoint (list en2))
)
(if (listp sp)
(progn (setq ep (vlax-curve-getEndPoint en2))
 (cond ((equal sp pt 1e-8)
 (setq en2lst (cons (list en2 ep) en2lst))
 )
 ((equal ep pt 1e-8)
 (setq en2lst (cons (list en2 sp) en2lst))
 )
 )
)
)
)
)
)
en2lst
)

;;选择连续线c:ss -----fsxm 2007/01/29
(defun c:ss (/ en enp ept spt ss addnext)
(if (and (setq enp (entsel))
(ssget (cadr enp) '((0 . "*line,arc,circle,ellipse")))
)
(progn
(setq en (car enp))
(setq spt (vlax-curve-getStartPoint en))
(setq ept (vlax-curve-getendPoint en))
(setq ss (ssadd))
(ssadd en ss)
(defun addnext (en pt / next)
(if (setq next (gotonexten en pt))
(foreach a next
(if (not (ssmemb (car a) ss))
(progn (ssadd (car a) ss)
 (apply 'addnext a)
)
)
)
)
)
(addnext en spt)
(addnext en ept)
(if (= 0 (getvar "cmdactive"))
(sssetfirst nil ss)
)
ss
(jion)
)
(progn
(princ "\n未选取对象或选取了非curve类型对象!")
(princ)
)
)
)

(defun jion(/ ss s)
(setq ss (ssget '((-4 . "<OR")
(0 . "LINE")(0 . "ARC")
(-4 . "<AND")(0 . "LWPOLYLINE")(70 . 0)(-4 . "AND>")
(-4 . "OR>")))
)
(while ss
(setq s (ssname ss 0))
(if (or (= "LINE" (cdr (assoc 0 (entget s))))
(= "ARC" (cdr (assoc 0 (entget s))))
)
(command "pedit" s "y" "j" "p" "" "x")
(command "pedit" s "j" "p" "" "x")
)
(setq ss (ssget "p"))
)
(princ)
)

xuexicad1960 发表于 2012-3-15 17:11:49

qcw911 修改的小程序是针对直线的连接，很好用。我现在更需要能连接pline 线的程序。

页: [1] 2 3 4 5

明经CAD社区's Archiver

首尾相连的N条直线 选中其中任何一条都能选中N条线段 如何用lisp实现啊

首尾相连的N条直线选中其中任何一条都能选中N条线段如何用lisp实现啊