[分享]批量圆转多段线（源码）

zxdcad

用PL绘制圆弧再闭合是比较简单的一种方式生成多段线圆，


      ((= (cdr TC) "CIRCLE")
       (setq xy (cdr (assoc 10 b1)))
       (setq xy0 (trans xy 0 1))
       (setq ra (cdr (assoc 40 b1)))
       (setq ks (polar xy0 0 ra))
       (entdel ty)
       (command "pline" ks "w" kd kd "a" "ce" xy0 "a" 180 "cl")
      )

xiaxiang

这程序好像不应该收费。。。个人意见

elitefish

圆转多线 应该是转成 圆环吧  

Gu_xl

我也来一个，ActiveX方法的！

2. 
   
3. 
   
4. (defun c:tt(/ modelspace)
   
5.   
   
6.   (setq oldosmode (getvar "osmode")
   
7. oldcmdecho (getvar "cmdecho")
   
8. )
   
9.   (setq modelspace (vla-get-ModelSpace (vla-get-activedocument(vlax-get-acad-object))))
   
10.   (setvar "osmode" 0)
    
11.   (setvar "cmdecho" 0)
    
12.   (setq ss (ssget '((0 . "circle"))))
    
13.   (setq k 0)
    
14.   (if ss
    
15.     (repeat (sslength ss)
    
16.       (setq en (ssname ss k))
    
17.       (setq cp (cdr (assoc 10 (setq enl (entget en))))
    
18.      r (cdr (assoc 40 enl))
    
19.      )
    
20.       (setq p1 (polar cp pi r)
    
21.      p2 (polar cp 0 r)
    
22.      )
    
23.       (setq pts (list p1 p2)
    
24.      pts (mapcar '(lambda (x) (list (car x) (cadr x))) pts)
    
25.       n (* 2 (length pts))
    
26.      )
    
27.       (setq arypts (vlax-make-variant
    
28.        (vlax-safearray-fill
    
29.          (vlax-make-safearray vlax-vbdouble (cons 1 n))
    
30.          (apply 'append pts)
    
31.        ) ;_ vlax-safearray-fill
    
32.      ) ;_ vlax-make-variant
    
33.       ) ;_ setq
    
34.       (setq obj (vla-AddLightWeightPolyline modelspace arypts))
    
35.       (vla-put-Closed obj :vlax-true)
    
36.       (vla-SetBulge obj 0 1)
    
37.       (vla-SetBulge obj 1 1)
    
38.       (setq k (1+ k))
    
39.       (command "_matchprop" en (entlast) "")
    
40.       (entdel en)
    
41.       )
    
42.     )
    
43.     (setvar "osmode" oldosmode)
    
44.   (setvar "cmdecho" oldcmdecho)
    
45.   )

<br /> <br /> (defun c:tt(/ modelspace)<br />   <br />   (setq oldosmode (getvar "osmode")<br /> oldcmdecho (getvar "cmdecho")<br /> )<br />   (setq modelspace (vla-get-ModelSpace (vla-get-activedocument(vlax-get-acad-object))))<br />   (setvar "osmode" 0)<br />   (setvar "cmdecho" 0)<br />   (setq ss (ssget '((0 . "circle"))))<br />   (setq k 0)<br />   (if ss<br />     (repeat (sslength ss)<br />       (setq en (ssname ss k))<br />       (setq cp (cdr (assoc 10 (setq enl (entget en))))<br />      r (cdr (assoc 40 enl))<br />      )<br />       (setq p1 (polar cp pi r)<br />      p2 (polar cp 0 r)<br />      )<br />       (setq pts (list p1 p2)<br />      pts (mapcar '(lambda (x) (list (car x) (cadr x))) pts)<br />       n (* 2 (length pts))<br />      )<br />       (setq arypts (vlax-make-variant<br />        (vlax-safearray-fill<br />          (vlax-make-safearray vlax-vbdouble (cons 1 n))<br />          (apply 'append pts)<br />        ) ;_ vlax-safearray-fill<br />      ) ;_ vlax-make-variant<br />       ) ;_ setq<br />       (setq obj (vla-AddLightWeightPolyline modelspace arypts))<br />       (vla-put-Closed obj :vlax-true)<br />       (vla-SetBulge obj 0 1)<br />       (vla-SetBulge obj 1 1)<br />       (setq k (1+ k))<br />       (command "_matchprop" en (entlast) "")<br />       (entdel en)<br />       )<br />     )<br />     (setvar "osmode" oldosmode)<br />   (setvar "cmdecho" oldcmdecho)<br />   )

xyp1964

2. ;; circle → 多段线
   
3. (defun c:tt ()
   
4.   (defun dxf (code elist) (cdr (assoc code elist)))
   
5.   (setq        ss (ssget '((0 . "circle")))
   
6.         n  -1
   
7.   )
   
8.   (while (setq s1 (ssname ss (setq n (1+ n))))
   
9.     (setq et (entget s1)
   
10.           pt (dxf 10 et)
    
11.           r  (* (dxf 40 et) 2)
    
12.     )
    
13.     (command "donut" r r "non" pt "")
    
14.     (entdel s1)
    
15.   )
    
16.   (princ)
    
17. )
    

;; circle → 多段线<br /> (defun c:tt ()<br />   (defun dxf (code elist) (cdr (assoc code elist)))<br />   (setq        ss (ssget '((0 . "circle")))<br />         n  -1<br />   )<br />   (while (setq s1 (ssname ss (setq n (1+ n))))<br />     (setq et (entget s1)<br />           pt (dxf 10 et)<br />           r  (* (dxf 40 et) 2)<br />     )<br />     (command "donut" r r "non" pt "")<br />     (entdel s1)<br />   )<br />   (princ)<br /> )<br />

yoyoho

感谢诸位高手分享程序!

偏爱云~小吴

高手啊，可以来个逆向的么，我需要将多线段转为圆，怎么搞，请高手帮忙

gzbccy

都不错。值得学习

ygp820601

xyp1964 发表于 2010-12-7 18:29

当UCS与WCS不一致时，转换后的多段线的圆与原来的圆不在同一位置哦。