拾取一条线，相连线均亮显----已经解决，谢谢众乡亲!

/db_自贡黄明儒_

;这些线均在可视范围内，可老提示repeat 后为nil,即使用if判断后执行repeat也不行。以前觉得简单，可写起来就不是那么回事了。哪位高手指点一下？
;;点线显示相连的线
(defun C:W2 (/ E N P SS SS0)
  (defun HH:EndPtEnts (p e fuzz / E1 N PT SS)
    (setq ss (ssget "_C" p p '((0 . "*LINE,ARC"))))
    (repeat (setq n (sslength ss))
      (setq e1 (ssname ss (setq n (1- n))))
      (cond
        ((ssmemb e1 ss0) nil)
        (T
         (setq pt (vlax-curve-getStartPoint e))
         (cond ((equal p pt fuzz) nil)
               (T (HH:EndPtEnts pt e1 fuzz))
         )
         (setq pt (vlax-curve-getEndPoint e))
         (cond ((equal p pt fuzz) nil)
               (T (HH:EndPtEnts pt e1 fuzz))
         )
         (ssadd e1 ss0)
        )
      )
    )
  )
  (setq ss0 (ssget "_+.:E:S" '((0 . "*LINE,ARC"))))
  (setq e (ssname ss0 0))
  (setq p (vlax-curve-getStartPoint e))
  (HH:EndPtEnts p e 0.1)
  (setq p (vlax-curve-getEndPoint e))
  (HH:EndPtEnts p e 0.1)
  (repeat (setq n (sslength ss0)) (redraw (ssname ss0
Rn) 3) (setq n (1-  n)))
)

q3_2006

ll_j 发表于 2014-5-6 11:15
那个问题要求不清晰，换句话说，关联表不是那样用的。
比如表中有'(5 6)和'(6 5)，岂不要死循环，如果re ...

这个是群里网友的求助,处理直线端点表什么的可以是扩展功能,就这个表'((6 7)(1 2)(3 4)(6 5)(2 3)(7 8)),凡是x或y有一项相同就分为同一组,这个用递归写我就绕不过来...拜托长老用递归法解决下,谢谢了....即使表中有'(5 6)和'(6 5)...也没关系...加入同一组内的表就不在查找范围内了,不会死循环..也无所谓顺序的....只要分成一组就行.....

liuyj

只是首尾相连的？相交和相切的怎么判断？

/db_自贡黄明儒_

liuyj 发表于 2014-5-5 09:24
只是首尾相连的？相交和相切的怎么判断？

相连也没有搞定呢{:soso_e109:},还管得了那么多？

csharp

1子函数中点选择也用"_:E"加过滤，然后判断是否相连
2 亮显试试sssetfirst

/db_自贡黄明儒_

csharp 发表于 2014-5-5 11:10
1子函数中点选择也用"_:E"加过滤，然后判断是否相连
2 亮显试试sssetfirst

好象不行吧，你试过了？

q3_2006

G版的....
;;选择直线相连 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)
        (setq  cnt 0)
        (repeat (sslength ss2)
  (ssadd (ssname ss2 cnt) ss)
  (setq cnt (1+ cnt))
)
        (setq  cnt 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 ss  pz)
(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)
  )

/db_自贡黄明儒_

q3_2006 发表于 2014-5-5 11:50
G版的....
;;选择直线相连 By Gu_xl
(defun c:tt(/ gxl-Sel-ReDrawSel gxl-Sel-SSsub gxl-Sel-SSJoin gxl ...

这个是G版的，写得太长了。我的想法是能不能写短点。

st788796

选线，取首尾点，:E靶框内所有线选集，遍历选集，判断各首尾点是否为选点，是取另一个端点循环
1 点是否在屏幕内
2 用递归可能简化
3 还可以将第一次的首尾点构造一个list 然后用 while cdr 这个表去选，相连线的另一个端点再cons 进来

/db_自贡黄明儒_

st788796 发表于 2014-5-5 13:20
选线，取首尾点，:E靶框内所有线选集，遍历选集，判断各首尾点是否为选点，是取另一个端点循环
1 点是否在 ...

长老，我用的是第二，递归，为什么就是不行呢？帮看看呀！

st788796

/db_自贡黄明儒_ 发表于 2014-5-5 14:08
长老，我用的是第二，递归，为什么就是不行呢？帮看看呀！

主程序的repeat 是 ss0
子函数中首尾是平行条件，都要执行，不是只执行一个
另外增加判断点是否在屏幕内判断, :E 只能用于拾取选择，不接受点参数， c p p不保障能全选到，最好用当前靶框构造，另外你只考虑了一一连接，如果有一端连接多个线时这个算法不适用

/db_自贡黄明儒_

st788796 发表于 2014-5-5 14:58
主程序的repeat 是 ss0
子函数中首尾是平行条件，都要执行，不是只执行一个
另外增加判断点是否在屏 ...

长老呀，你这个回答还是不痛不痒的。关键是我这个运行不了，找不到原因。
即使我确保这些线都在可视范围内也不行。显示错误为:子函数repeat 后为nil

st788796

/db_自贡黄明儒_ 发表于 2014-5-5 15:47
长老呀，你这个回答还是不痛不痒的。关键是我这个运行不了，找不到原因。
即使我确保这些线都在可视范围 ...

nil 就是ssget为 空啊，去掉捕捉，用当前靶框大小构造 C 参数，然后筛选出来连接线

ll_j

最后的(1+ n)是不是该(1- n)？

/db_自贡黄明儒_

ll_j 发表于 2014-5-5 18:03
最后的(1+ n)是不是该(1- n)？

元老呀，后面亮显语句是错了°主要还是那个递归子函数运行不了，我百思不得其解，郁闷几天了

/db_自贡黄明儒_

ll_j 发表于 2014-5-5 18:03
最后的(1+ n)是不是该(1- n)？

谢谢指正！估计还是运行不了