批量圆转多段线（源码）

网友答:
  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. )


网友答:
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以适合钣金加工的。



网友答: 转换的份数可以选就好了，期待..

网友答: 很简单啊.我也来一个.
  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))


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

网友答:

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

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



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

网友答:

改天我贴上来！！！



网友答: 本帖最后由 redcat 于 2011-1-18 23:16 编辑


  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





网友答: 高手云集啊

网友答: 大家继续讨论不用管我
我只是看看在新论坛里自己的样子
  • 上一篇：提升累加测距程序
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025