如何批量 将圆和圆弧 转化为多段线

cheefeel

求这样一款插件：

选中一堆包含各种对象的图形，然后能将其中的圆和圆弧转换成多段线。
如果连椭圆也能椭圆也拟合成多段线就更好了。

guosheyang

http://bbs.mjtd.com/thread-186768-1-1.html  这对你这问题  写了两个函数 供参考

llsheng_73

也发个自己弄来转多线段的，不敢说好，但绝对纯源码
http://bbs.mjtd.com/forum.php?mo ... &fromuid=202795
(出处: 明经CAD社区)

cheefeel

llsheng_73 发表于 2022-12-5 15:59
也发个自己弄来转多线段的，不敢说好，但绝对纯源码
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=1 ...

这个不错，不过不是我想要的那种，我想的比方说一个圆弧直接转多段线，但是不分段。就像用PEDIT那样去处理，PEDIT也能多选，但是解决不了圆。

cq4920

2. ;圆弧转多段线
   
3. ;h为弓高（即弦中心至相对应弧之中心的距离）
   
4. ;它用来描述以弦代弧的光滑程度，一般化取0.005mm(图上距离)即可
   
5. (defun arc->pline (en h / xtblm xtblz ALEN ENT LEN LST N PT PTLST R SUM)
   
6.   (setq #t0# (getvar "cdate"))
   
7.   (setq        xtblm '("cmdecho" "osmode")
   
8.         xtblz (mapcar 'getvar xtblm)
   
9.         r     (yj-dxf 40 en)
   
10.         len   (vlax-curve-getDistAtPoint en (vlax-curve-getEndPoint en))
    
11.         alen  (* (atan (/ (sqrt (- (* 2.0 r h) (* h h))) (- r h))) r)
    
12.         n     (fix (/ len alen))
    
13.         alen  (/ len n)
    
14.         sum   alen
    
15.         ptlst '()
    
16.   )
    
17.   (repeat n
    
18.     (setq pt (vlax-curve-getpointatdist en sum))
    
19.     (setq ptlst (append ptlst (list (cons 10 pt)(cons 40 0)(cons 41 0)(cons 42 0)) ))
    
20.     (setq sum (+ sum alen))
    
21.     )
    
22.   (setq ent (entget en))
    
23.   (setq lst '((0 . "LWPOLYLINE")))
    
24.      (foreach x '(100 67 410 8 62 6 370)
    
25.        (if (assoc x
    
26.                   ent
    
27.            ) ;_  assoc
    
28.          (setq lst (cons (assoc x ent) lst))
    
29.        ) ;_  if
    
30.      ) ;_  foreach
    
31.      (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
    
32.      (entmakex
    
33.        (append
    
34.          (reverse lst)
    
35.          (list
    
36.            '(100 . "AcDbPolyline")
    
37.            (cons 90 (1+ n))
    
38.            '(70 . 0)
    
39.            (cons 38 (cadddr (assoc 10 ent)))
    
40.            (cons
    
41.              10
    
42.              (vlax-curve-getStartPoint en
    
43.              ) ;_  reverse
    
44.            ) ;_  cons
    
45.            '(40 . 0)
    
46.            '(41 . 0)
    
47.            '(42 . 0)
    
48.          )
    
49.          ptlst
    
50.          (list
    
51.            (assoc 210 ent)
    
52.          ) ;_  list
    
53.        ) ;_  append
    
54.      ) ;_  entmakex
    
55.      ;(Vlax-Put-Property (Vlax-Ename->Vla-Object (entlast)) 'Color 1)
    
56.      (entdel en)
    
57.      (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
    
58.   (mapcar 'setvar xtblm xtblz)
    
59.   (princ)
    
60. )
    
61. ;;;按指组码找出全图元的组码值
    
62.     (defun yj-dxf (key ename) (cdr (assoc key (entget ename))))   
    
63. ;测试程序
    
64. (defun c:c2l ()
    
65.         (setq ent (car (entsel "\n请选取要转化多段线的圆弧:")))
    
66.         (setq jd (getreal "\n请设置圆弧精度:"))
    
67.         (if jd nil
    
68.                 (setq jd 0.05)
    
69.         )
    
70.   (arc->pline ent jd)
    
71.   (princ
    
72.     (strcat "\n耗时："
    
73.             (rtos (* 1000000 (- (getvar "cdate") #t0#) 2 3))
    
74.             "秒"
    
75.     )
    
76.   )
    
77.   (princ)
    
78. )

;圆弧转多段线<br /> ;h为弓高（即弦中心至相对应弧之中心的距离）<br /> ;它用来描述以弦代弧的光滑程度，一般化取0.005mm(图上距离)即可<br /> (defun arc->pline (en h / xtblm xtblz ALEN ENT LEN LST N PT PTLST R SUM)<br />   (setq #t0# (getvar "cdate"))<br />   (setq        xtblm '("cmdecho" "osmode")<br />         xtblz (mapcar 'getvar xtblm)<br />         r     (yj-dxf 40 en)<br />         len   (vlax-curve-getDistAtPoint en (vlax-curve-getEndPoint en))<br />         alen  (* (atan (/ (sqrt (- (* 2.0 r h) (* h h))) (- r h))) r)<br />         n     (fix (/ len alen))<br />         alen  (/ len n)<br />         sum   alen<br />         ptlst '()<br />   )<br />   (repeat n <br />     (setq pt (vlax-curve-getpointatdist en sum))<br />     (setq ptlst (append ptlst (list (cons 10 pt)(cons 40 0)(cons 41 0)(cons 42 0)) ))<br />     (setq sum (+ sum alen))<br />     )<br />   (setq ent (entget en))<br />   (setq lst '((0 . "LWPOLYLINE"))) <br />      (foreach x '(100 67 410 8 62 6 370) <br />        (if (assoc x <br />                   ent <br />            ) ;_  assoc <br />          (setq lst (cons (assoc x ent) lst)) <br />        ) ;_  if <br />      ) ;_  foreach <br />      (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) <br />      (entmakex<br />        (append<br />          (reverse lst)<br />          (list<br />            '(100 . "AcDbPolyline")<br />            (cons 90 (1+ n))<br />            '(70 . 0)<br />            (cons 38 (cadddr (assoc 10 ent)))<br />            (cons<br />              10<br />              (vlax-curve-getStartPoint en<br />              ) ;_  reverse <br />            ) ;_  cons <br />            '(40 . 0)<br />            '(41 . 0)<br />            '(42 . 0)<br />          )<br />          ptlst<br />          (list<br />            (assoc 210 ent)<br />          ) ;_  list <br />        ) ;_  append <br />      ) ;_  entmakex<br />      ;(Vlax-Put-Property (Vlax-Ename->Vla-Object (entlast)) 'Color 1)<br />      (entdel en) <br />      (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) <br />   (mapcar 'setvar xtblm xtblz)<br />   (princ)<br /> )<br /> ;;;按指组码找出全图元的组码值<br />     (defun yj-dxf (key ename) (cdr (assoc key (entget ename))))   <br /> ;测试程序<br /> (defun c:c2l ()<br />         (setq ent (car (entsel "\n请选取要转化多段线的圆弧:")))<br />         (setq jd (getreal "\n请设置圆弧精度:"))<br />         (if jd nil<br />                 (setq jd 0.05)<br />         )<br />   (arc->pline ent jd)<br />   (princ<br />     (strcat "\n耗时："<br />             (rtos (* 1000000 (- (getvar "cdate") #t0#) 2 3))<br />             "秒"<br />     )<br />   )<br />   (princ)<br /> )

wzg356

http://bbs.mjtd.com/thread-182691-1-1.html
各种线取样提取坐标适用line,lwpolyline,polyline,spline,circle,arc,ellipse


我多个帖子函数都在使用转为多线段

lee50310

圓,弧轉多段線 你的需求是不是轉完後不影響原來大小 頂點數越少 越好

cheefeel

感谢各位大佬的回复，可能是我的表述不专业，实际1楼是我想要的结果

llsheng_73

1. (defun arctopl(p r ang1 ang2 / a);;圆(弧)转多段线
   
2.   (setq a(*(rem(+(- ang2 ang1)pi pi)(+ pi pi))0.25)a(cons 42(/(sin a)(cos a))))
   
3.   (List(cons 10(polar p ang1 r))a(cons 10(polar p ang2 r))a))
   
4. (defun tt(e yn / en p r ang1 ang2)
   
5.   (setq en(entget e)
   
6.         p(cdr(assoc 10 en))
   
7.         r(cdr(assoc 40 en))
   
8.         ang1(cdr(assoc 50 en)))
   
9.   (entmakex(vl-remove'nil(append(mapcar'cons'(0 100 100 90 70)(list"LWPOLYLINE""AcDbEntity""AcDbPolyline"2(if ang1 0 1)))(list(assoc 8 en)(assoc 370 en)(assoc 62 en))
   
10.                                 (if ang1(arctopl p r ang1(cdr(assoc 51 en)))(arctopl p r 0 pi)))))
    
11.   (or(="1"Yn)(entdel e)))
    
12. (defun c:tt(/ e Yn )
    
13.   (initget "1 2")
    
14.   (or(member(setq Yn(getkword"1.保留圆(弧) 2.不保留圆(弧)[2]"))'("1""2"))(setq Yn"2"))
    
15.   (while(setq e(ssget":E:S"'((0 . "circle,arc"))))
    
16.     (tt(ssname e 0)Yn))
    
17.   )

(defun arctopl(p r ang1 ang2 / a);;圆(弧)转多段线<br />   (setq a(*(rem(+(- ang2 ang1)pi pi)(+ pi pi))0.25)a(cons 42(/(sin a)(cos a))))<br />   (List(cons 10(polar p ang1 r))a(cons 10(polar p ang2 r))a))<br /> (defun tt(e yn / en p r ang1 ang2)<br />   (setq en(entget e)<br />         p(cdr(assoc 10 en))<br />         r(cdr(assoc 40 en))<br />         ang1(cdr(assoc 50 en)))<br />   (entmakex(vl-remove'nil(append(mapcar'cons'(0 100 100 90 70)(list"LWPOLYLINE""AcDbEntity""AcDbPolyline"2(if ang1 0 1)))(list(assoc 8 en)(assoc 370 en)(assoc 62 en))<br />                                 (if ang1(arctopl p r ang1(cdr(assoc 51 en)))(arctopl p r 0 pi)))))<br />   (or(="1"Yn)(entdel e)))<br /> (defun c:tt(/ e Yn )<br />   (initget "1 2")<br />   (or(member(setq Yn(getkword"1.保留圆(弧) 2.不保留圆(弧)[2]"))'("1""2"))(setq Yn"2"))<br />   (while(setq e(ssget":E:S"'((0 . "circle,arc"))))<br />     (tt(ssname e 0)Yn))<br />   )