[分享]批量圆转多段线（源码）
<font face="Verdana">批量圆转多段线（源码）</font> ;; circle → 多段线(defun c:tt ()
(defun dxf (code elist) (cdr (assoc code elist)))
(setq ss (ssget '((0 . "circle")))
n-1
)
(while (setq s1 (ssname ss (setq n (1+ n))))
(setq et (entget s1)
pt (dxf 10 et)
r(* (dxf 40 et) 2)
)
(command "donut" r r "non" pt "")
(entdel s1)
)
(princ)
)
ljttjl 发表于 2010-11-1 21:01
圆、椭圆、样条曲线转多段线程序见：
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=68784&extra=&pa ...
好东西，收藏了！！！！！！！！ 本帖最后由 cchessbd 于 2022-12-19 19:34 编辑
可以可以。但是您这个精度有些问题。我改成了40以适合钣金加工的。
转换的份数可以选就好了，期待.. 很简单啊.我也来一个.
(defun gps->Circle-2plinelst (pt r n / ang nang pt1 ptlst)(setq nang (/ (* 2 pi) n) ang 0)(repeat n (setq pt1 (polar pt ang r)) (setq ang (+ angnang)) (setq ptlst (append ptlst (list pt1))) ))
(defun gps->entmake-pline(pt_lst lay clsd) (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 8 lay) (cons 90 (length pt_lst)) (cons 70 clsd); 1闭合 ) (mapcar '(lambda (pt) (cons 10 pt)) pt_lst) ) ) ) (defun gps->ss-2lst (ss / lst n)(if (= (type ss) 'PICKSET) (repeat (setq n (sslength ss)) (setq lst (cons (ssname ss (setq n (1- n))) lst)) ) )lst)(defun c:cl()(if (null $fs)(setq $fs 10)) (setq tmp (getint (strcat "\n圆转多段线,请输入等份数量<" (itoa $fs) ">:")))(if tmp (setq $fs tmp))(foreach n (gps->ss-2lst (ssget '((0 . "Circle")))) (setq ptlst (entget n) lay (cdr (assoc 8 ptlst))pt (cdr (assoc 10 ptlst)) r (cdr (assoc 40 ptlst))) (gps->entmake-pline (gps->Circle-2plinelst pt r $fs) lay 1) (entdel n))(prin1)) 呵呵 ，楼上的这个是将圆变成了多边行，再改该吧（我承认我这个也是，只是多了看不出） <p><font face="Verdana">圆、椭圆、样条曲线转多段线程序见：</font></p>
<p><font face="Verdana">http://bbs.mjtd.com/forum.php?mod=viewthread&tid=68784&extra=&page=1</font></p> 上面的的都太复杂了，其实很简单，最简单的就几行代码就搞定，复杂一点也用不了这么多代码，非常简单的事情！！！！！ <p>改天我贴上来！！！</p> 本帖最后由 redcat 于 2011-1-18 23:16 编辑
(defun redcat_circle_pl (/ entlst setpick i norm layer center r pro_x)
(setq setpick (ssget '((0 . "CIRCLE")))
i 0
) ;_ 结束setq
(repeat (sslength setpick)
(setq entlst (entget (ssname setpick i))) ;_ 结束setq
(setq norm(assoc 67 entlst) ;图形在模型空间或图纸空间
layer(assoc 8 entlst) ;图层
center (assoc 10 entlst) ;圆心
r(cdr (assoc 40 entlst)) ;半径
pro_x(assoc 210 entlst) ;X轴拉伸方向
;;;....其余代码根据需要自行添加
) ;_ 结束setq
(entmake (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
norm
'(410 . "Model")
layer
'(100 . "AcDbPolyline")
'(90 . 3)
'(70 . 0)
'(43 . 0.0)
'(38 . 0.0)
'(39 . 0.0)
(list 10 (- (cadr center) r) (- (caddr center) r))
'(40 . 0.0)
'(41 . 0.0)
'(42 . 1.0)
'(91 . 0)
(list 10 (- (cadr center) r) (+ (caddr center) r))
'(40 . 0.0)
'(41 . 0.0)
'(42 . 1.0)
'(91 . 0)
(list 10 (- (cadr center) r) (- (caddr center) r))
'(40 . 0.0)
'(41 . 0.0)
'(42 . 0.46903)
'(91 . 0)
pro_x
) ;_ 结束list
) ;_ 结束entmake
(entdel (ssname setpick i))
(setq i (1+ i))
) ;_ 结束repeat
(princ)
) ;_ 结束defun
高手云集啊 大家继续讨论不用管我
我只是看看在新论坛里自己的样子