多段线首尾相连，选择后按顺序返回表

1506822004 · 发表于 2023-12-4 10:17

写了一个框选很多条多段线，多段线首尾相连，然后选择起始点以后，返回按照前后顺序排列的表

试了很多图都能实现，就附件那个图出问题了，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))
)

飞雪神光 · 发表于 2023-12-4 14:34

实际的 vlax-curve-getstartpoint 并不都是理想的状态

1506822004 · 发表于 2023-12-4 14:58

飞雪神光发表于 2023-12-4 14:34
实际的 vlax-curve-getstartpoint 并不都是理想的状态

那这个思路就行不通了，能不能提点一下，应该按什么思路来写

飞雪神光 · 发表于 2023-12-4 15:22

用起始和结束两个点来比对每确定一个图元后将该图元从选择集中删除

xyp1964 · 发表于 2023-12-4 21:17

本帖最后由 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)
)

(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) 
)

1506822004 · 发表于 2023-12-4 23:34

xyp1964 发表于 2023-12-4 21:17

感谢版主大人

xyp1964 · 发表于 2023-12-5 00:13

本帖最后由 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)
)

(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) 
)

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

[函数] 多段线首尾相连，选择后按顺序返回表

本帖子中包含更多资源