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

yjr111 · 发表于 2011-9-15 00:21:10

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

yshf · 发表于 2013-12-28 20:24:45

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

Andyhon · 发表于 2011-9-15 08:17:17

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

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

sen.sam · 发表于 2011-9-15 09:56:23

搜索一下，论坛上很多！

snddd2000 · 发表于 2011-9-15 16:39:14

(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 · 发表于 2011-9-15 16:51:18

如果只是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 · 发表于 2011-9-15 20:59:15

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

林霄云 · 发表于 2013-12-28 19:17:14

本帖最后由林霄云于 2013-12-31 15:56 编辑

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

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

翔飞125 · 发表于 2015-3-12 13:00:46

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

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

skg123 · 发表于 2016-1-1 20:50:51

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选取多段线:"))))))
)

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

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

本帖子中包含更多资源