llsheng_73 发表于 2013-10-18 15:54:16

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

自己弄了好久,转多线段倒好办,按长度找点就是了,但又想顺便把多线段上的冗余点去掉,再加上比较懒,想到一点弄一点,拖拖拉拉的就搞了好久(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 "Polyline" 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 发表于 2024-6-4 20:32:17

大佬,你好,想问下(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 发表于 2018-11-15 11:58:46

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

tanxindong 发表于 2024-10-16 09:40:49

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

llsheng_73 发表于 2013-10-18 15:55:41

沙发不准抢走了

vlisp2012 发表于 2013-10-18 21:20:07

弄个板凳也不错嘛?

清风明月名字 发表于 2013-10-19 17:53:47

谢谢楼主分享,辛苦了!

sicky111 发表于 2013-10-23 00:12:46

谢谢楼主分享。

zs2002zs 发表于 2013-10-24 12:42:09

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

spiderman 发表于 2013-10-28 00:16:55

谢谢楼主分享。

ynhh 发表于 2013-11-9 16:07:42

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

emk 发表于 2014-4-15 13:29:42

来支持下73

树櫴希德 发表于 2014-4-15 13:43:44

命令: 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):*取消*
; 错误: 函数被取消
页: [1] 2 3 4 5
查看完整版本: 也发个自己弄来转多线段的,不敢说好,但绝对纯源码