|
自己弄了好久，转多线段倒好办，按长度找点就是了，但又想顺便把多线段上的冗余点去掉，再加上比较懒，想到一点弄一点，拖拖拉拉的就搞了好久 (defun GetCord(ob)
(vlax-safearray->list(vlax-variant-value(vla-get-Coordinates ob)))
)
(defun StarEnd(ob)
(list(append(list(vlax-curve-getstartparam ob))(vlax-curve-getstartpoint ob))
(append(list(vlax-curve-getendparam ob))(vlax-curve-getendpoint ob))))
(defun x(OBJ l p q o C / F)
(SETQ F(if(and(>(+(distance p q)(distance q o))l)(<(abs(*(distance p q)(sin(-(angle p q)(angle p o)))))C))1 2))
)
(defun insertlist(Lst en n / l m s)
(cond((= n 0)(setq s(append(list en)LST)))
((= n(setq l(length LST)))(setq s(append LST(list en))))
(T(setq m 1 s(list(car LST)))
(while(< m n)(setq s(append s(list(nth m LST)))m(1+ m)))
(setq s(append s (list en)))
(while(< m l)(setq s(append s(list(nth m LST)))m(1+ m)))))
(setq Lst s))
(defun removelist(Lst n / l m s)
(if(= n 0)(setq s(cdr l))
(progn(setq m 1 s(list(car LST)))
(while(< m n)(setq s(append s(list(nth m LST)))m(1+ m)))(setq m(1+ n))
(while(< m l)
(setq s(append s(list(nth m LST)))m(1+ m)))))
(setq Lst s))
(defun c:CTP(/ D Pt ob a b c c2 p q o m n l F);;将各种线段转为多线段，将多线段上的弧线段也转为多线段
(vl-load-com)
(SETQ S(SSGET'((0 . "line,lwpolyline,polyline,spline,circle,arc,ellipse")))NM 0 MN(if s(SSLENGTH S)0))
(while(not(and(> c2 0.65)(< c2 1)))(setq C2(getreal"\n采样精度(0.65～1):")))
(setq C(/(- 1.0 C2)2))
(WHILE(< NM MN)
(SETQ en(SSNAME S NM)NM(1+ NM)
ob(vlax-ename->vla-object en)a 0 n 1 pt nil D(vla-get-objectname ob)
l(vlax-curve-getdistatparam ob(vlax-curve-getendparam ob))
m(cond((= D"AcDb3dPolyline")3)((= D"AcDb2dPolyline")2)((= D"AcDbPolyline")2)))
(if(or(= D"AcDb3dPolyline")(= D"AcDbPolyline"))
(if(vl-catch-all-error-p(vl-catch-all-apply 'vla-get-Coordinates(list ob)))(setq Pt(StarEnd ob))
(progn(setq q(vlax-safearray->list(vlax-variant-value(vla-get-Coordinates ob))))
(repeat(/(length q)m)(cond((= m 2)(setq p(list(nth a q)(nth(+ a 1)q))))
((= m 3)(setq p(list(nth a q)(nth(+ a 1)q)(nth(+ a 2)q)))))
(setq a(+ a m)
Pt(if(or(null Pt)(>(distance p(cdr(car(reverse Pt))))0.00005))
(append Pt(list(append(list(vlax-curve-getparamatpoint ob p))p)))pt)))))
(setq Pt(StarEnd ob)))
(while(< n(length Pt))
(setq m(1- n)a(vlax-curve-getdistAtparam ob(car(nth m Pt)))
b(-(vlax-curve-getdistAtparam ob(car(nth n Pt)))a))
(if(<= b 0)(setq b(- l a)))
(setq o(vlax-curve-getparamatdist ob(+(/ b 2)a))
r(append(list o)(vlax-curve-getpointatparam ob o))
F(x ob (* b c2)(cdr(nth m Pt))(cdr r)(cdr(nth n Pt))c))
(cond((= F 1)(setq n(1+ n)))
((= F 2)(setq Pt(insertlist Pt r n))))
)
(setq F(if(vlax-curve-isClosed ob)1 0)b(entget(vlax-vla-object->ename ob)'("*"))
Pt(if(and(= F 1)(NULL(vl-string-search " olyline" D)))(reverse(cdr(reverse Pt)))Pt))
(setq a(list(cons 0 "LWPOLYLINE")(cons 8(cdr(assoc 8 b)))(cons 6(if(assoc 6 b)(cdr(assoc 6 b))"Bylayer"))
(cons 62(if(assoc 62 b)(cdr(assoc 62 b))256))(cons 370(if(assoc 370 b)(cdr(assoc 370 b))0))
(cons 48(if(assoc 48 b)(cdr(assoc 48 b))1))(cons 100 "AcDbEntity")(cons 100 "AcDbPolyline")
(cons 90(-(length Pt)F))(cons 70 (+ 128 F))(cons 43(if(assoc 43 b)(cdr(assoc 43 b))0))
(cons 38(caddr(vlax-curve-getstartpoint ob)))(cons 39(if(assoc 39 b)(cdr(assoc 39 b))0)))
a(append a(foreach b Pt(setq Pt(subst(subst 10(car b)b)b Pt)))))
(entmake(if(assoc -3 b)(append a(list(assoc -3 b)))a))
(prin1))
)
(princ "将线转为多线段,采样精度不要小于0.65，当然也要小于1,OK?建议0.95,命令:CTP\n")
;;取CurveToPoline缩写,命令名取得不好不准喷我口水，程序写得不好希望提出建议
;;售价纯粹想看下明经币长什么样子，源码放在帖子里边就没想过真要它变钱钱
| 
[复制链接]
发表于 2013-10-18 15:54
置顶卡
变色卡
显身卡
楼主