;;;来一个固版主的：
(setq ent (car(entsel "\n选取多段线: ")))
(mapcar 'cdr (vl-remove-if-not '(lam ...
G版的只能是多段线，二维用这个
;;支持2D\3D多段线点提取
;;edit by edata 2014-1-25
(defun sk_vertex(ent / lst ety x)
(defun sk_dxf(en code)
(cdr (assoc code (entget en)))
)
(setq lst '()
ety (sk_dxf ent 0)
)
(cond
((= ety "POLYLINE")
(while (/= (sk_dxf ent 0) "SEQEND")
(setq ent(entnext ent))
(if (= (sk_dxf ent 0) "VERTEX")
(setq lst(cons (sk_dxf ent 10) lst))))
(if(/= lst '())(reverse lst) nil))
((= ety "LWPOLYLINE")
(setq e1(entget ent))
(while (setq pt(car e1))
(if(= (car pt) 10)
(setq lst(cons (cdr pt) lst))
)
(setq e1(cdr e1)))
(if(/= lst '())(reverse lst) nil)
;(mapcar 'cdr (vl-remove-if-not '(lambda(x)(= 10 (car x)))(entget ent)))
)
)
)
(defun c:tt()
(sk_vertex (car (entsel)))
) (defun Plinexy(e / p a b n ob q et d d1 en et)
(setq a(entget e)ob(vlax-ename->vla-object e)et(cdr(assoc 0 a))n 0 p nil d nil)
(cond((="LWPOLYLINE"et)
(repeat(length a)(setq b (nth n a) n (+ n 1))
(if (= 10 (car b))(progn
(setq q(list (cadr b) (caddr b))d1(vlax-curve-getDistAtPoint ob q))
(if p (if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))
(setq p (list q))))
)))
((="POLYLINE"et)
(SETQ EN (ENTGET (SETQ E (ENTNEXT E))))
(WHILE (/= (CDR (ASSOC 0 EN)) "SEQEND")
(SETQ q (CDR (ASSOC 10 EN))d1(vlax-curve-getDistAtPoint ob q)q(reverse(cdr(reverse q))))
(if p(if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))
(setq p (list q)))
(SETQ EN (ENTGET (SETQ E (ENTNEXT E)))))
(setq p(reverse p))
))
P)
;;二维、三维、多线段节点坐标(滤掉了多余点，未处理假闭合) USER2128 发表于 2014-1-25 08:38 static/image/common/back.gif
;;;来一个固版主的：
(setq ent (car(entsel "\n选取多段线: ")))
(mapcar 'cdr (vl-remove-if-not '(lam ...
那啥，这是提取多段线的吧，二维多段线是不行的 llsheng_73 发表于 2014-1-25 13:41 static/image/common/back.gif
;;二维、三维、多线段节点坐标(滤掉了多余点，未处理假闭合)
谢谢大大帮助，感谢！ llsheng_73 发表于 2014-1-25 13:41 ;;二维、三维、多线段节点坐标(滤掉了多余点，未处理假闭合)
看看7楼的链接，可以省点代码。 llsheng_73 发表于 2014-1-25 13:41 static/image/common/back.gif
;;二维、三维、多线段节点坐标(滤掉了多余点，未处理假闭合)
纯Alisp提取多段线 2D\3D多段线顶点，去重复点加闭合
;;支持2D\3D多段线点提取,重复点将去掉\处理假的闭合
;;暂时未考虑多点共线
;;edit by edata 2014-1-26
;;modfiy by edata 2014-1-27
;;要放假了,又得消失一段时间
;;(mapcar 'cdr (vl-remove-if-not '(lambda(x)(= 10 (car x)))(entget ent)))
(defun sk_vertex(ent / lst ety x)
(defun sk_dxf(en code)
(cdr (assoc code (entget en)))
)
(defun sk_removept(lst flag / newlst)
(setq newlst '())
(while (car lst)
(if (not(equal (car lst) (cadr lst) 1e-8))
(setq newlst(cons (car lst) newlst)))
(setq lst(cdr lst))
)
(if(/= newlst '())
(if (or(and flag
(= flag 1)
(equal (car newlst)(last newlst) 1e-8))
(equal (car newlst)(last newlst) 1e-8))
(reverse (cdr newlst))
(reverse newlst)
)
nil )
)
(setq lst '()
ety (sk_dxf ent 0)
isclosed (logand 1(sk_dxf ent 70))
)
(cond
((= ety "POLYLINE")
(while (/= (sk_dxf ent 0) "SEQEND")
(setq ent(entnext ent))
(if (= (sk_dxf ent 0) "VERTEX")
(setq lst(cons (sk_dxf ent 10) lst))))
(if(/= lst '())(sk_removept (reverse lst) isclosed) nil))
((= ety "LWPOLYLINE")
(setq e1(entget ent))
(while (setq pt(car e1))
(if(= (car pt) 10)
(setq lst(cons (cdr pt) lst))
)
(setq e1(cdr e1)))
(if(/= lst '())(sk_removept (reverse lst) isclosed) nil)
)
)
)
(defun c:tt()
(princ(sk_vertex (car (entsel))))
;(princ(Plinexy (car (entsel))))
(princ)
) 学习，收藏 学习一下。。我一般都是把二维多段线转为多段线再编辑的。
页:
1
[2]