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

ll_j · 发表于 2014-5-5 19:16:24

/db_自贡黄明儒_ 发表于 2014-5-5 19:03
元老呀，后面亮显语句是错了°主要还是那个递归子函数运行不了，我百思不得其解，郁闷几天了

递归中的n是局部函数，每次都重新开始，最终可能陷入一个“死循环”，如果不用局部函数，则可能出现“漂移”，得到的不是想要的值。
建议换个思路，不用递归，可以用选择集或表遍历及增减，避开这个问题。
不懂vl函数，所以也不测试了，就建议在这里了。

zxq0220 · 发表于 2014-5-5 20:49:55

本帖最后由 zxq0220 于 2014-5-5 22:18 编辑

错误多多。下面是改好的。

(defun C:W2 (/ E N P)
(defun HH:EndPtEnts (p e fuzz / E1 N PT SS)
(setq ss (ssget "_C" p p '((0 . "LINE,*POLYLINE,SPLINE,ARC"))))
(if (> (sslength ss) 1) (progn
(ssdel e ss)
(repeat (setq n (sslength ss))
(setq e1 (ssname ss (setq n (1- n))))
(if (not (eq e0 e1)) (progn
(ssadd e1 ss0)
(setq pt (vlax-curve-getStartPoint e1))
(if (not (equal (distance p pt) 0.0 fuzz)) (HH:EndPtEnts pt e1 fuzz))
(setq pt (vlax-curve-getEndPoint e1))
(if (not (equal (distance p pt) 0.0 fuzz)) (HH:EndPtEnts pt e1 fuzz))
))
)
(setq ss nil)
))
)
(setq ss0 (ssget "_+.:E:S" '((0 . "LINE,*POLYLINE,SPLINE,ARC"))))
(setq e0 (ssname ss0 0))
(setq p (vlax-curve-getStartPoint e0))
(HH:EndPtEnts p e0 0.1)
(setq p (vlax-curve-getEndPoint e0))
(HH:EndPtEnts p e0 0.1)
(repeat (setq n (sslength ss0)) (redraw (ssname ss0 (setq n (1- n))) 3))
)

(defun C:W2 (/ E N P) 
 (defun HH:EndPtEnts (p e fuzz / E1 N PT SS) 
  (setq ss (ssget "_C" p p '((0 . "LINE,*POLYLINE,SPLINE,ARC")))) 
  (if (> (sslength ss) 1) (progn 
   (ssdel e ss) 
   (repeat (setq n (sslength ss)) 
    (setq e1 (ssname ss (setq n (1- n)))) 
    (if (not (eq e0 e1)) (progn 
     (ssadd e1 ss0) 
     (setq pt (vlax-curve-getStartPoint e1)) 
     (if (not (equal (distance p pt) 0.0 fuzz)) (HH:EndPtEnts pt e1 fuzz)) 
     (setq pt (vlax-curve-getEndPoint e1)) 
     (if (not (equal (distance p pt) 0.0 fuzz)) (HH:EndPtEnts pt e1 fuzz)) 
    )) 
   ) 
  (setq ss nil) 
  )) 
 ) 
 (setq ss0 (ssget "_+.:E:S" '((0 . "LINE,*POLYLINE,SPLINE,ARC")))) 
 (setq e0 (ssname ss0 0)) 
 (setq p (vlax-curve-getStartPoint e0)) 
 (HH:EndPtEnts p e0 0.1) 
 (setq p (vlax-curve-getEndPoint e0)) 
 (HH:EndPtEnts p e0 0.1) 
 (repeat (setq n (sslength ss0)) (redraw (ssname ss0 (setq n (1- n))) 3)) 
)

夜来风语声 · 发表于 2014-5-5 22:04:56

zxq0220 发表于 2014-5-5 20:49
错误多多。下面是改好的。

当线围合成闭合时，选择集数量的最大范围！

命令: w2
选择对象:
; 错误: 超出选择集数量的最大范围
命令:

zxq0220 · 发表于 2014-5-5 22:19:35

夜来风语声发表于 2014-5-5 22:04
当线围合成闭合时，选择集数量的最大范围！

命令: w2

程序改好了。再试试。

Free-Lancer · 发表于 2014-5-6 01:09:07

非递归

(defun c:tt (/ e lst ss lss0 sp0 ep0 sp ep tlst p)
(if (setq e
(ssget "_+.:S:E" '((0 . "arc,*line")))
)
(progn
(setq e (ssname e 0)
lst (list (vlax-curve-getstartpoint e)
(vlax-curve-getendpoint e)
)
ss (ssadd)
)
(ssadd e ss)
(while lst
(setq tlst (cons (car lst) tlst)
p (car lst)
lst (cdr lst)
)
(if (setq
ss0 (ssget "_C" p p '((0 . "arc,*line")))
)
(progn
(setq l (sslength ss0))
(while (setq ee (ssname ss0 (setq l (1- l))))
(setq sp0 (vlax-curve-getstartpoint ee)
ep0 (vlax-curve-getendpoint ee)
)
(if
(and
(not (vl-some '(lambda (x) (equal x sp0 1e-3)) lst))
(not (vl-some '(lambda (x) (equal x sp0 1e-3)) tlst))
)
(progn
(setq lst (cons sp0 lst))
(ssadd ee ss)
)
)
(if
(and
(not (vl-some '(lambda (x) (equal x ep0 1e-3)) lst))
(not (vl-some '(lambda (x) (equal x ep0 1e-3)) tlst))
)
(progn
(setq lst (cons ep0 lst))
(ssadd ee ss)
)
)
)
)
)
)
(if ss
(sssetfirst nil ss)
)
)
)
(princ)
)

(defun c:tt (/ e lst ss lss0 sp0 ep0 sp ep tlst p) 
  (if (setq e 
             (ssget "_+.:S:E" '((0 . "arc,*line"))) 
      ) 
    (progn 
      (setq e        (ssname e 0) 
            lst        (list (vlax-curve-getstartpoint e) 
                      (vlax-curve-getendpoint e) 
                ) 
            ss        (ssadd) 
      ) 
      (ssadd e ss) 
      (while lst 
        (setq tlst (cons (car lst) tlst) 
              p (car lst) 
              lst  (cdr lst) 
        ) 
        (if (setq 
              ss0 (ssget "_C" p p '((0 . "arc,*line"))) 
            ) 
          (progn 
            (setq l (sslength ss0)) 
            (while (setq ee (ssname ss0 (setq l (1- l)))) 
              (setq sp0        (vlax-curve-getstartpoint ee) 
                    ep0        (vlax-curve-getendpoint ee) 
              ) 
              (if 
                (and 
                  (not (vl-some '(lambda (x) (equal x sp0 1e-3)) lst)) 
                  (not (vl-some '(lambda (x) (equal x sp0 1e-3)) tlst)) 
                ) 
                 (progn 
                   (setq lst (cons sp0 lst)) 
                   (ssadd ee ss) 
                 ) 
              ) 
              (if 
                (and 
                  (not (vl-some '(lambda (x) (equal x ep0 1e-3)) lst)) 
                  (not (vl-some '(lambda (x) (equal x ep0 1e-3)) tlst)) 
                ) 
                 (progn 
                   (setq lst (cons ep0 lst)) 
                   (ssadd ee ss) 
                 ) 
              ) 
            ) 
          ) 
        ) 
      ) 
      (if ss 
        (sssetfirst nil ss) 
      ) 
    ) 
  ) 
  (princ) 
)

q3_2006 · 发表于 2014-5-6 08:44:06

zxq0220 发表于 2014-5-5 22:19
程序改好了。再试试。

当线围合成闭合时，选择集数量的最大范围！
... 还是这个错误哟!

/db_自贡黄明儒_ · 发表于 2014-5-6 10:26:01

本帖最后由 /db_自贡黄明儒_ 于 2014-5-6 10:39 编辑

q3_2006 发表于 2014-5-6 08:44
当线围合成闭合时，选择集数量的最大范围！
... 还是这个错误哟!

(defun C:W2 (/ E N P)
  (defun HH:EndPtEnts (p e fuzz / E1 EN N PT SS)
(cond
   ((and
  (setq ss (ssget "_C" p p '((0 . "*LINE,ARC"))))
  (> (sslength ss) 1)
   )
   (repeat (setq n (sslength ss0))
  (setq en (ssname ss0 (setq n (1- n))))
  (cond ((ssmemb en ss) (ssdel en ss)))
   )
   (repeat (setq n (sslength ss))
  (setq e1 (ssname ss (setq n (1- n))))
  (ssadd e1 ss0)
  (setq pt (vlax-curve-getStartPoint e1))
  (cond ((not (equal p pt fuzz)) (HH:EndPtEnts pt e1 fuzz)))
  (setq pt (vlax-curve-getEndPoint e1))
  (cond ((not (equal p pt fuzz)) (HH:EndPtEnts pt e1 fuzz)))
   )
   )
)
  )
  (setq ss0 (ssget "_+.:E:S" '((0 . "*LINE,ARC"))))
  (setq e0 (ssname ss0 0))
  (setq p (vlax-curve-getStartPoint e0))
  (HH:EndPtEnts p e0 0.1)
  (setq p (vlax-curve-getEndPoint e0))
  (HH:EndPtEnts p e0 0.1)
  (repeat (setq n (sslength ss0)) (redraw (ssname ss0 (setq n (1- n))) 3))
)

q3_2006 · 发表于 2014-5-6 11:02:18

/db_自贡黄明儒_ 发表于 2014-5-6 10:26
(defun C:W2 (/ E N P)
(defun HH:EndPtEnts (p e fuzz / E1 EN N PT SS)
(cond

请黄工帮忙解决下这个问题....http://www.xdcad.net/forum/thread-673592-1-1.html主要是想学好递归...现在严重半调子...递归用的人好少...范例太少....复杂点我就转不过来了....拜托抽空看看...谢谢!

ll_j · 发表于 2014-5-6 11:15:00

q3_2006 发表于 2014-5-6 11:02
请黄工帮忙解决下这个问题....http://www.xdcad.net/forum/thread-673592-1-1.html主要是想学好递归... ...

那个问题要求不清晰，换句话说，关联表不是那样用的。
比如表中有'(5 6)和'(6 5)，岂不要死循环，如果remove，怎知该那个在前？
表的处理应该针对应用的题目比较容易，有目的、有输入条件才好想办法。那个楼主在3楼似乎提到与多段线顶点有关，不说还好些，说了更不清楚了。

q3_2006 · 发表于 2014-5-6 13:09:59

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)...也没关系...加入同一组内的表就不在查找范围内了,不会死循环..也无所谓顺序的....只要分成一组就行.....

牢固 · 发表于 2014-5-6 13:19:45

本帖最后由牢固于 2018-6-12 11:30 编辑

/db_自贡黄明儒_ 发表于 2014-5-6 10:26
(defun C:W2 (/ E N P)
(defun HH:EndPtEnts (p e fuzz / E1 EN N PT SS)
(cond

只要是在递归里用选择集，就会有选择集数量超限的风险！
以下是非递归法，不存在选择数量超限问题:

Array，本帖隐藏的内容需要发帖数高于 2 才可浏览，你当前发帖数为

q3_2006 · 发表于 2014-5-6 14:53:26

牢固发表于 2014-5-6 13:19
只要是在递归里用选择集，就会有选择集数量超限的风险！
以下是非递归法，不存在选择数量超限问题:
[/p ...

http://www.xdcad.net/forum/thread-673592-1-1.html
G版也顺便看下这个呗....希望用递归方法解决....看来大家对递归都不怎么感冒呢....只有G版之前用递归法帮我解决过问题呀...拜托了....{:soso_e154:}

hnfsf · 发表于 2014-5-7 10:15:34

G版出来看看，用您独到的办法解决这个问题。。。

zwwen12 · 发表于 2014-5-7 13:22:54

对于图案较密的还是有问题，会出错

lijiao · 发表于 2014-5-8 15:59:56

(defun cs-get-link ( / ent)
  (setq ssed '() sss '())
  (if (setq ent (car (entsel)))
(progn
   (setq ent (cs-ch-ss ent "vla")) ;;;将ENAME转换为Vla-OBJECT
   (cs-get-sublink ent)
   (if ssed
(sssetfirst nil (cs-ch-ss ssed "ss"));;;将图元列表转换为选择集
   )
   )
)
  ssed
  )

(defun cs-get-sublink (ent / JINGDU PT1 PT2 SS0 SS1 SS2 X)
  (setq jingdu 0.001)
  (setq pt1 (vlax-curve-getStartPoint ent)
pt2 (vlax-curve-getendPoint ent))
  (if (not (member pt1 sss))
(setq ss1 (ssget "c" pt1 pt1)
   sss (cons pt1 sss))
(setq ss1 nil)
)
  (if (not (member pt2 sss))
(setq ss2 (ssget "c" pt2 pt2)
   sss (cons pt2 sss))
(setq ss2 nil)
)
  (setq ss0 (append (cs-ch-ss ss1 "vla") (cs-ch-ss ss2 "vla")));;;将ENAME转换为Vla-OBJECT
  (setq ss0 (mapcar '(lambda (x)
         (if (not (member x ssed)) x))
      ss0))
  (setq ss0 (vl-remove nil ss0))
  (setq ss0 (mapcar '(lambda(x)
         (if (or (equal pt1 (vlax-curve-getStartPoint x) jingdu)
         (equal pt2 (vlax-curve-getStartPoint x) jingdu)
         (equal pt1 (vlax-curve-getendPoint x) jingdu)
         (equal pt2 (vlax-curve-getendPoint x) jingdu)
         )
   x)
         )
      ss0))
  (setq ss0 (vl-remove nil ss0))
  (setq ssed (append ss0 ssed))
  (foreach item ss0
(cs-get-sublink item)
)
  )

账号		自动登录	找回密码
密码			立即注册

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

点评

评分

点评

点评

点评

评分

点评

点评

点评

点评

点评

评分

点评

点评

评分