二维多段线没有顶点表，怎么提取顶点坐标呢？（注意：不是多段线）还请各位大大解答！

edata

USER2128 发表于 2014-1-25 08:38
;;;来一个固版主的：
(setq ent (car(entsel "\n选取多段线: ")))
(mapcar 'cdr (vl-remove-if-not '(lam ...

G版的只能是多段线，二维用这个

1. ;;支持2D\3D多段线点提取
   
2. ;;edit by edata 2014-1-25
   
3. (defun sk_vertex(ent / lst ety x)
   
4.   (defun sk_dxf(en code)
   
5.     (cdr (assoc code (entget en)))
   
6.     )
   
7.   (setq        lst '()
   
8.         ety (sk_dxf ent 0)
   
9.         )
   
10.   (cond
    
11.     ((= ety "POLYLINE")
    
12.      (while (/= (sk_dxf ent 0) "SEQEND")
    
13.        (setq ent(entnext ent))
    
14.        (if (= (sk_dxf ent 0) "VERTEX")
    
15.          (setq lst(cons (sk_dxf ent 10) lst))))
    
16.      (if(/= lst '())(reverse lst) nil))
    
17.     ((= ety "LWPOLYLINE")
    
18.      (setq e1(entget ent))
    
19.      (while (setq pt(car e1))
    
20.        (if(= (car pt) 10)
    
21.          (setq lst(cons (cdr pt) lst))
    
22.          )
    
23.        (setq e1(cdr e1)))
    
24.       
    
25.      (if(/= lst '())(reverse lst) nil)
    
26.      ;(mapcar 'cdr (vl-remove-if-not '(lambda(x)(= 10 (car x)))(entget ent)))
    
27.      )
    
28.     )
    
29.   )
    
30. (defun c:tt()
    
31.   (sk_vertex (car (entsel)))
    
32.   )

;;支持2D\3D多段线点提取<br /> ;;edit by edata 2014-1-25 <br /> (defun sk_vertex(ent / lst ety x)<br />   (defun sk_dxf(en code)<br />     (cdr (assoc code (entget en)))<br />     )<br />   (setq        lst '()<br />         ety (sk_dxf ent 0)<br />         )<br />   (cond<br />     ((= ety "POLYLINE")<br />      (while (/= (sk_dxf ent 0) "SEQEND")<br />        (setq ent(entnext ent))<br />        (if (= (sk_dxf ent 0) "VERTEX")<br />          (setq lst(cons (sk_dxf ent 10) lst))))<br />      (if(/= lst '())(reverse lst) nil))<br />     ((= ety "LWPOLYLINE")<br />      (setq e1(entget ent))<br />      (while (setq pt(car e1))<br />        (if(= (car pt) 10)<br />          (setq lst(cons (cdr pt) lst))<br />          )<br />        (setq e1(cdr e1)))<br />        <br />      (if(/= lst '())(reverse lst) nil)<br />      ;(mapcar 'cdr (vl-remove-if-not '(lambda(x)(= 10 (car x)))(entget ent)))<br />      )<br />     )<br />   )<br /> (defun c:tt()<br />   (sk_vertex (car (entsel)))<br />   )

llsheng_73

1. (defun Plinexy(e / p a b n ob q et d d1 en et)
   
2.    (setq a(entget e)ob(vlax-ename->vla-object e)et(cdr(assoc 0 a))n 0 p nil d nil)
   
3.    (cond((="LWPOLYLINE"et)
   
4.          (repeat(length a)(setq b (nth n a) n (+ n 1))
   
5.            (if (= 10 (car b))(progn
   
6.                                (setq q(list (cadr b) (caddr b))d1(vlax-curve-getDistAtPoint ob q))
   
7.                                (if p (if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))
   
8.                                  (setq p (list q))))
   
9.              )))
   
10.         ((="POLYLINE"et)
    
11.          (SETQ EN (ENTGET (SETQ E (ENTNEXT E))))
    
12.          (WHILE (/= (CDR (ASSOC 0 EN)) "SEQEND")
    
13.            (SETQ q (CDR (ASSOC 10 EN))d1(vlax-curve-getDistAtPoint ob q)q(reverse(cdr(reverse q))))
    
14.            (if p(if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))
    
15.              (setq p (list q)))
    
16.            (SETQ EN (ENTGET (SETQ E (ENTNEXT E)))))
    
17.          (setq p(reverse p))
    
18.          ))
    
19.    P)

(defun Plinexy(e / p a b n ob q et d d1 en et) <br />    (setq a(entget e)ob(vlax-ename->vla-object e)et(cdr(assoc 0 a))n 0 p nil d nil)<br />    (cond((="LWPOLYLINE"et)<br />          (repeat(length a)(setq b (nth n a) n (+ n 1))<br />            (if (= 10 (car b))(progn<br />                                (setq q(list (cadr b) (caddr b))d1(vlax-curve-getDistAtPoint ob q))<br />                                (if p (if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))<br />                                  (setq p (list q))))<br />              )))<br />         ((="POLYLINE"et)<br />          (SETQ EN (ENTGET (SETQ E (ENTNEXT E))))<br />          (WHILE (/= (CDR (ASSOC 0 EN)) "SEQEND")<br />            (SETQ q (CDR (ASSOC 10 EN))d1(vlax-curve-getDistAtPoint ob q)q(reverse(cdr(reverse q))))<br />            (if p(if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))<br />              (setq p (list q)))<br />            (SETQ EN (ENTGET (SETQ E (ENTNEXT E)))))<br />          (setq p(reverse p))<br />          ))<br />    P)

;;二维、三维、多线段节点坐标(滤掉了多余点，未处理假闭合)

重慶崽兒

USER2128 发表于 2014-1-25 08:38
;;;来一个固版主的：
(setq ent (car(entsel "\n选取多段线: ")))
(mapcar 'cdr (vl-remove-if-not '(lam ...

那啥，这是提取多段线的吧，二维多段线是不行的

重慶崽兒

llsheng_73 发表于 2014-1-25 13:41
;;二维、三维、多线段节点坐标(滤掉了多余点，未处理假闭合)

谢谢大大帮助，感谢！

edata

llsheng_73 发表于 2014-1-25 13:41 ;;二维、三维、多线段节点坐标(滤掉了多余点，未处理假闭合)

看看7楼的链接，可以省点代码。

edata

llsheng_73 发表于 2014-1-25 13:41
;;二维、三维、多线段节点坐标(滤掉了多余点，未处理假闭合)

纯Alisp提取多段线 2D\3D多段线顶点，去重复点加闭合

1. ;;支持2D\3D多段线点提取,重复点将去掉\处理假的闭合
   
2. ;;暂时未考虑多点共线
   
3. ;;edit by edata 2014-1-26
   
4. ;;modfiy by edata 2014-1-27
   
5. ;;要放假了,又得消失一段时间
   
6. ;;(mapcar 'cdr (vl-remove-if-not '(lambda(x)(= 10 (car x)))(entget ent)))
   
7. (defun sk_vertex(ent / lst ety x)
   
8.   (defun sk_dxf(en code)
   
9.     (cdr (assoc code (entget en)))
   
10.     )
    
11.   (defun sk_removept(lst flag / newlst)
    
12.   (setq newlst '())
    
13.     (while (car lst)
    
14.       (if (not(equal (car lst) (cadr lst) 1e-8))
    
15.         (setq newlst(cons (car lst) newlst)))
    
16.       (setq lst(cdr lst))
    
17.       )
    
18.   (if(/= newlst '())
    
19.     (if (or(and flag
    
20.              (= flag 1)
    
21.              (equal (car newlst)(last newlst) 1e-8))
    
22.            (equal (car newlst)(last newlst) 1e-8))      
    
23.       (reverse (cdr newlst))
    
24.       (reverse newlst)
    
25.       )
    
26.     nil )
    
27.   )
    
28.   (setq lst '()
    
29.         ety (sk_dxf ent 0)
    
30.         isclosed (logand 1(sk_dxf ent 70))
    
31.         )
    
32.   (cond
    
33.     ((= ety "POLYLINE")
    
34.      (while (/= (sk_dxf ent 0) "SEQEND")
    
35.        (setq ent(entnext ent))
    
36.        (if (= (sk_dxf ent 0) "VERTEX")
    
37.          (setq lst(cons (sk_dxf ent 10) lst))))
    
38.      (if(/= lst '())(sk_removept (reverse lst) isclosed) nil))
    
39.     ((= ety "LWPOLYLINE")
    
40.      (setq e1(entget ent))
    
41.      (while (setq pt(car e1))
    
42.        (if(= (car pt) 10)
    
43.          (setq lst(cons (cdr pt) lst))
    
44.          )
    
45.        (setq e1(cdr e1)))      
    
46.      (if(/= lst '())(sk_removept (reverse lst) isclosed) nil)      
    
47.      )
    
48.     )
    
49.   )
    
50. 
    
51. (defun c:tt()
    
52.   (princ(sk_vertex (car (entsel))))
    
53.   ;(princ(Plinexy (car (entsel))))
    
54.   (princ)
    
55.   )

;;支持2D\3D多段线点提取,重复点将去掉\处理假的闭合<br /> ;;暂时未考虑多点共线<br /> ;;edit by edata 2014-1-26<br /> ;;modfiy by edata 2014-1-27<br /> ;;要放假了,又得消失一段时间<br /> ;;(mapcar 'cdr (vl-remove-if-not '(lambda(x)(= 10 (car x)))(entget ent)))<br /> (defun sk_vertex(ent / lst ety x)<br />   (defun sk_dxf(en code)<br />     (cdr (assoc code (entget en)))<br />     )<br />   (defun sk_removept(lst flag / newlst)<br />   (setq newlst '())<br />     (while (car lst)<br />       (if (not(equal (car lst) (cadr lst) 1e-8))<br />         (setq newlst(cons (car lst) newlst)))<br />       (setq lst(cdr lst))<br />       )<br />   (if(/= newlst '())<br />     (if (or(and flag<br />              (= flag 1)<br />              (equal (car newlst)(last newlst) 1e-8))<br />            (equal (car newlst)(last newlst) 1e-8))      <br />       (reverse (cdr newlst))<br />       (reverse newlst)<br />       )<br />     nil )<br />   )<br />   (setq lst '()<br />         ety (sk_dxf ent 0)<br />         isclosed (logand 1(sk_dxf ent 70))<br />         )<br />   (cond<br />     ((= ety "POLYLINE")<br />      (while (/= (sk_dxf ent 0) "SEQEND")<br />        (setq ent(entnext ent))<br />        (if (= (sk_dxf ent 0) "VERTEX")<br />          (setq lst(cons (sk_dxf ent 10) lst))))<br />      (if(/= lst '())(sk_removept (reverse lst) isclosed) nil))<br />     ((= ety "LWPOLYLINE")<br />      (setq e1(entget ent))<br />      (while (setq pt(car e1))<br />        (if(= (car pt) 10)<br />          (setq lst(cons (cdr pt) lst))<br />          )<br />        (setq e1(cdr e1)))       <br />      (if(/= lst '())(sk_removept (reverse lst) isclosed) nil)      <br />      )<br />     )<br />   )<br /> <br /> (defun c:tt()<br />   (princ(sk_vertex (car (entsel))))<br />   ;(princ(Plinexy (car (entsel))))<br />   (princ)<br />   )

我来看MM的

学习，收藏

evayleung

学习一下。。我一般都是把二维多段线转为多段线再编辑的。