请教怎么列出多段线的所有顶点坐标？

yjr111

如题：怎么列出多段线的所有顶点坐标？用ASSOC好像只能列出主实体的10组码？

yshf

(setq ptb (mapcar 'cdr (vl-remove-if '(lambda(x)(/= (car x) 10)) (entget (car (entsel "\n选取多段线:"))))))

Andyhon

此中有
http://bbs.mjtd.com/thread-10652-1-1.html

老帖中亦有不同写法滴 ....

sen.sam

搜索一下，论坛上很多！

snddd2000

(defun get-pline-point (ent / ptlist ptlist1)

(vl-load-com)
(setq ptlist '() ptlist1 '() n 0)
(setq ptlist (vlax-safearray->list
  (vlax-variant-value
    (vlax-get-property
      (vlax-ename->vla-object ent)
      'Coordinates
      )
    )
  )
       )
  (cond
    (
     (= "LWPOLYLINE" (cdr (assoc 0 (entget ent)
     )
     )
)
    (progn
      (repeat (/ (length ptlist) 2)
(setq ptlist1 (cons (list (nth n ptlist)
      (nth (setq n (1+ n)) ptlist)
      )
       ptlist1)      
       )
(setq n (1+ n))
)
      )
     )
    (
     (= "POLYLINE" (cdr (assoc 0 (entget ent)
         )
         )
     )
    (progn
      (repeat (/ (length ptlist) 3)
(setq ptlist1 (cons (list (nth n ptlist)
      (nth (setq n (1+ n)) ptlist)
      (nth (setq n (1+ n)) ptlist)
      )
       ptlist1)
       )
(setq n (1+ n))
)
      )
     )
    )
(princ (reverse ptlist1))
(princ)
)

;;;结束，需先判断图元是否为"LWPOLYLINE,POLYLINE"


在知道图元名的时候直接用(get-pline-point ent)，返回如表((x1 y1 [z1])(x2 y2 [z2])(x3 y3 [z3])...)。

snddd2000

如果只是lwpolyline
(setq ent1  (entget (car (entsel))))
(mapcar '(lambda(X)
(if (= 10 (car x))(setq ptlist1 (cons (cdr x) ptlist1)))
)
ent1
)
(princ (reverse ptlist1))
(princ)

zoubo604

CAD的 list命令不就可以列表出来嘛

林霄云

2. (defun get_pline_vertex()
   
3. (setq ent1  (entget (car (entsel))));用于测试。可以作为参数传递对象。
   
4. (setq ptlist1 nil);设初始值。
   
5.   
   
6. (mapcar '(lambda(X)
   
7. (if (= 10 (car x))
   
8. 
   
9.   (setq ptlist1 (cons (cdr x) ptlist1)))
   
10.   
    
11. );lambda
    
12. ent1
    
13. );mapcar
    
14. (princ (reverse ptlist1))
    
15. (princ)
    
16.   );defun

(defun get_pline_vertex()<br /> (setq ent1  (entget (car (entsel))));用于测试。可以作为参数传递对象。<br /> (setq ptlist1 nil);设初始值。<br />   <br /> (mapcar '(lambda(X)<br /> (if (= 10 (car x))<br /> <br />   (setq ptlist1 (cons (cdr x) ptlist1)))<br />   <br /> );lambda<br /> ent1<br /> );mapcar<br /> (princ (reverse ptlist1))<br /> (princ)<br />   );defun

另附cons和append耗时区别：http://bbs.mjtd.com/forum.php?mo ... 870&fromuid=7303580

翔飞125

yshf 发表于 2013-12-28 20:24
(setq ptb (mapcar 'cdr (vl-remove-if '(lambda(x)(/= (car x) 10)) (entget (car (entsel "\n选取多段线: ...

很实用很实用很实用很实用很实用

skg123

yshf 发表于 2013-12-28 20:24
(setq ptb (mapcar 'cdr (vl-remove-if '(lambda(x)(/= (car x) 10)) (entget (car (entsel "\n选取多段线: ...

很简洁
(defun c:tt ()
(setq ptb (mapcar 'cdr (vl-remove-if '(lambda(x)(/= (car x) 10)) (entget (car (entsel "\n选取多段线:"))))))
)