也发个自己弄来转多线段的，不敢说好，但绝对纯源码

llsheng_73

自己弄了好久，转多线段倒好办，按长度找点就是了，但又想顺便把多线段上的冗余点去掉，再加上比较懒，想到一点弄一点，拖拖拉拉的就搞了好久

(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缩写,命令名取得不好不准喷我口水，程序写得不好希望提出建议
;;售价纯粹想看下明经币长什么样子，源码放在帖子里边就没想过真要它变钱钱

fangmin723

大佬，你好，想问下(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
          )
  )
)
这个函数怎么理解，麻烦大佬，帮忙解解惑，感谢&#128591;&#127995;&#128591;&#127995;&#128591;&#127995;

ynhh

谢谢73大师
请教你这个能不能改为
多线控制点保持样条曲线的拟合点位置和数据不变
不知要如何改？
请大师指点

tanxindong

建议大佬加上将转换的后的多义线连接成为一整根线段，如果首尾相连建能做成是封闭的多义线

llsheng_73

沙发不准抢走了

vlisp2012

弄个板凳也不错嘛？

清风明月名字

谢谢楼主分享，辛苦了！

sicky111

谢谢楼主分享。

zs2002zs

相当的可以，比CAD自带的好。

spiderman

谢谢楼主分享。

ynhh

支持你
你的心态和精神都是

emk

来支持下73

树櫴希德

命令: ctp
选择对象: 找到 1 个

选择对象:

采样精度(0.65～1):0.65

采样精度(0.65～1):1

采样精度(0.65～1):1

采样精度(0.65～1):1

采样精度(0.65～1):1

采样精度(0.65～1):1

采样精度(0.65～1):1

采样精度(0.65～1):111

采样精度(0.65～1):1

采样精度(0.65～1):1

采样精度(0.65～1):1

采样精度(0.65～1):1

采样精度(0.65～1):1

采样精度(0.65～1):1

采样精度(0.65～1):1

采样精度(0.65～1):1

采样精度(0.65～1):1

采样精度(0.65～1):*取消*
; 错误: 函数被取消