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

dkj0322

批量圆转多段线（源码）

心中的梦想

ljttjl 发表于 2010-11-1 21:01
圆、椭圆、样条曲线转多段线程序见：
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=68784&extra=&pa ...

好东西，收藏了！！！！！！！！

cchessbd

可以可以。但是您这个精度有些问题。我改成了40以适合钣金加工的。

spiderman

想下可惜没有币。

124350440

转换的份数可以选就好了，期待..

xshrimp

很简单啊.我也来一个.

2. (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 (+ ang  nang))         (setq ptlst (append ptlst (list pt1)))   ))
3. (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))

(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 (+ ang  nang))         (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))

dkj0322

呵呵 ，楼上的这个是将圆变成了多边行，再改该吧（我承认我这个也是，只是多了看不出）

ljttjl

圆、椭圆、样条曲线转多段线程序见：

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=68784&extra=&page=1

jxphklibin

上面的的都太复杂了，其实很简单，最简单的就几行代码就搞定，复杂一点也用不了这么多代码，非常简单的事情！！！！！

jxphklibin

改天我贴上来！！！

redcat

1. 
   
2. (defun redcat_circle_pl (/ entlst setpick i norm layer center r pro_x)
   
3.   (setq setpick (ssget '((0 . "CIRCLE")))
   
4. i 0
   
5.   ) ;_ 结束setq
   
6.   (repeat (sslength setpick)
   
7.     (setq entlst (entget (ssname setpick i))) ;_ 结束setq
   
8.     (setq norm  (assoc 67 entlst) ;图形在模型空间或图纸空间
   
9.    layer  (assoc 8 entlst) ;图层
   
10.    center (assoc 10 entlst) ;圆心
    
11.    r  (cdr (assoc 40 entlst)) ;半径
    
12.    pro_x  (assoc 210 entlst) ;X轴拉伸方向
    
13. ;;;....其余代码根据需要自行添加
    
14.     ) ;_ 结束setq
    
15.     (entmake (list '(0 . "LWPOLYLINE")
    
16.      '(100 . "AcDbEntity")
    
17.      norm
    
18.      '(410 . "Model")
    
19.      layer
    
20.      '(100 . "AcDbPolyline")
    
21.      '(90 . 3)
    
22.      '(70 . 0)
    
23.      '(43 . 0.0)
    
24.      '(38 . 0.0)
    
25.      '(39 . 0.0)
    
26.      (list 10 (- (cadr center) r) (- (caddr center) r))
    
27.      '(40 . 0.0)
    
28.      '(41 . 0.0)
    
29.      '(42 . 1.0)
    
30.      '(91 . 0)
    
31.      (list 10 (- (cadr center) r) (+ (caddr center) r))
    
32.      '(40 . 0.0)
    
33.      '(41 . 0.0)
    
34.      '(42 . 1.0)
    
35.      '(91 . 0)
    
36.      (list 10 (- (cadr center) r) (- (caddr center) r))
    
37.      '(40 . 0.0)
    
38.      '(41 . 0.0)
    
39.      '(42 . 0.46903)
    
40.      '(91 . 0)
    
41.      pro_x
    
42.       ) ;_ 结束list
    
43.     ) ;_ 结束entmake
    
44.     (entdel (ssname setpick i))
    
45.     (setq i (1+ i))
    
46.   ) ;_ 结束repeat
    
47.   (princ)
    
48. ) ;_ 结束defun
    
49. 
    
50. 
    

<br /> (defun redcat_circle_pl (/ entlst setpick i norm layer center r pro_x)<br />   (setq setpick (ssget '((0 . "CIRCLE")))<br /> i 0<br />   ) ;_ 结束setq<br />   (repeat (sslength setpick)<br />     (setq entlst (entget (ssname setpick i))) ;_ 结束setq<br />     (setq norm  (assoc 67 entlst) ;图形在模型空间或图纸空间<br />    layer  (assoc 8 entlst) ;图层<br />    center (assoc 10 entlst) ;圆心<br />    r  (cdr (assoc 40 entlst)) ;半径<br />    pro_x  (assoc 210 entlst) ;X轴拉伸方向<br /> ;;;....其余代码根据需要自行添加<br />     ) ;_ 结束setq<br />     (entmake (list '(0 . "LWPOLYLINE")<br />      '(100 . "AcDbEntity")<br />      norm<br />      '(410 . "Model")<br />      layer<br />      '(100 . "AcDbPolyline")<br />      '(90 . 3)<br />      '(70 . 0)<br />      '(43 . 0.0)<br />      '(38 . 0.0)<br />      '(39 . 0.0)<br />      (list 10 (- (cadr center) r) (- (caddr center) r))<br />      '(40 . 0.0)<br />      '(41 . 0.0)<br />      '(42 . 1.0)<br />      '(91 . 0)<br />      (list 10 (- (cadr center) r) (+ (caddr center) r))<br />      '(40 . 0.0)<br />      '(41 . 0.0)<br />      '(42 . 1.0)<br />      '(91 . 0)<br />      (list 10 (- (cadr center) r) (- (caddr center) r))<br />      '(40 . 0.0)<br />      '(41 . 0.0)<br />      '(42 . 0.46903)<br />      '(91 . 0)<br />      pro_x<br />       ) ;_ 结束list<br />     ) ;_ 结束entmake<br />     (entdel (ssname setpick i))<br />     (setq i (1+ i))<br />   ) ;_ 结束repeat<br />   (princ)<br /> ) ;_ 结束defun<br /> <br /> <br />

daiguafan

高手云集啊

masterlong

大家继续讨论不用管我
我只是看看在新论坛里自己的样子