多段线首尾相连，选择后按顺序返回表
写了一个框选很多条多段线，多段线首尾相连，然后选择起始点以后，返回按照前后顺序排列的表试了很多图都能实现，就附件那个图出问题了，8条多段线，返回前6条，不知道问题出在哪，大佬们帮忙看看
代码：
[*];保证所有线的方向一致
[*];使用：(Zport (getpoint))
[*](defun Zport (firstpt / a )
[*](setq ss (ssget '((8 . "主管"))) i 0 lenth 0);选择平面图
[*](prompt "选择平面图")
[*](repeat (sslength ss)
[*] (setq lyname (cdr (assoc 8 (entget (ssname ss i)))))
[*] (cond ((= "主管" lyname)
[*] (setq ss1 (cons (ssname ss i) ss1)))
[*] )
[*] (setq i (1+ i))
[*]);分别记录主管支管的图元名
[*](setq i 0)
[*](repeat (length ss1)
[*] (setq obj (vlax-ename->vla-object (nth i ss1)))
[*] (setq startpt (vlax-curve-getstartpoint obj));多段线第一个点
[*] (if (= (car firstpt) (car startpt))
[*] (if(= (car(cdr firstpt)) (car(cdr startpt)))
[*] (setq ssreal (list (nth i ss1)))
[*] )
[*] )
[*] (setq i (1+ i))
[*]);确定了第一条线
[*](setq i 0)
[*]
[*](repeat (length ss1)
[*] (setq obj (vlax-ename->vla-object (nth 0 ssreal)));排列合集!里面第一个元素（目前合集反着）
[*] (setq endpt (vlax-curve-getendpoint obj))
[*] (setq a 0)
[*] (repeat (length ss1)
[*] (setq obj1 (vlax-ename->vla-object (nth a ss1)));选择合集里面每一个元素
[*] (setq startpt1 (vlax-curve-getstartpoint obj1));选择合集里面每一个元素第一个点
[*] (if (= (car endpt) (car startpt1))
[*] (if (= (car(cdr endpt)) (car(cdr startpt1)))
[*] (setq ssreal (cons (nth a ss1) ssreal))
[*] )
[*] )
[*] (setq a (1+ a))
[*] )
[*])
[*](setq ssreal (reverse ssreal))
[*])
实际的vlax-curve-getstartpoint 并不都是理想的状态 飞雪神光 发表于 2023-12-4 14:34
实际的vlax-curve-getstartpoint 并不都是理想的状态
那这个思路就行不通了，能不能提点一下，应该按什么思路来写 用起始和结束两个点来比对 每确定一个图元后 将该图元从选择集中删除 本帖最后由 xyp1964 于 2023-12-4 21:22 编辑
(defun c:tt ()
"多段线首尾相连，选择后按顺序返回表"
(if (setq ss (ssget '((8 . "主管"))))
(progn
(setq lst (ssnamex ss)
lst (vl-remove-if '(lambda (x) (/= (type (cadr x)) 'ENAME)) lst)
lst (mapcar 'cadr lst)
lst (mapcar '(lambda (x)(list x(vlax-curve-getStartPoint x)(vlax-curve-getEndPoint x)))lst)
s1 (car lst)
lst (cdr lst)
lst0 (list (list 0 s1))
p1 (last s1)
p2 (cadr s1)
i 0
)
(while (setq a (vl-remove-if-not '(lambda (x) (member p1 (cdr x))) lst))
(setq s2 (car a)
i (1+ i)
lst0 (cons (list i s2) lst0)
p1 (car (vl-remove p1 (cdr s2)))
lst (vl-remove s2 lst)
)
)
(setq i 0)
(while (setq a (vl-remove-if-not '(lambda (x) (member p2 (cdr x))) lst))
(setq s2 (car a)
i (1- i)
lst0 (cons (list i s2) lst0)
p2 (car (vl-remove p2 (cdr s2)))
lst (vl-remove s2 lst)
)
)
(setq lst (vl-sort lst0 '(lambda (x y) (< (car x) (car y)))))
(setq lst (mapcar 'caadr lst))
;|(setq ptn (mapcar 'xyp-CurveMidPoint lst)
i 0
aa(mapcar '(lambda (x) (setq i (1+ i)) (xyp-Text 5 x (itoa i)))ptn)
l1 (xyp-Pline ptn nil)
)|;
)
)
(princ)
)
xyp1964 发表于 2023-12-4 21:17
感谢版主大人 本帖最后由 xyp1964 于 2023-12-5 00:14 编辑
(defun c:tt ()
"多段线首尾相连，选择后按顺序返回表"
(if (setq ss (ssget '((8 . "主管"))))
(progn
(setq lst (vl-remove-if '(lambda (x) (/= (type (cadr x)) 'ENAME)) (ssnamex ss))
lst (mapcar 'cadr lst)
lst (mapcar '(lambda (x)(list x(vlax-curve-getStartPoint x)(vlax-curve-getEndPoint x)))lst)
s1 (car lst)
lst (cdr lst)
lst0 (list s1)
p1 (last s1)
p2 (cadr s1)
)
(while (setq a (vl-remove-if-not '(lambda (x) (member p1 (cdr x))) lst))
(setq s2 (car a)
lst0 (append lst0 (list s2) lst0)
p1 (car (vl-remove p1 (cdr s2)))
lst (vl-remove s2 lst)
)
)
(while (setq a (vl-remove-if-not '(lambda (x) (member p2 (cdr x))) lst))
(setq s2 (car a)
lst0 (cons s2 lst0)
p2 (car (vl-remove p2 (cdr s2)))
lst (vl-remove s2 lst)
)
)
(setq lst(mapcar 'car lst0))
(princ lst)
)
)
(princ)
)
页:
[1]