gao6690 发表于 2008-3-11 10:23:00

[原创]圆弧转多段线

<p>;圆弧转多段线<br/>;h为弓高（即弦中心至相对应弧之中心的距离）<br/>;它用来描述以弦代弧的光滑程度，一般化取0.005mm(图上距离)即可<br/>(defun arc-&gt;pline(ent h / xtblm xtblz db r po a0 h n)<br/>(setq xtblm '("cmdecho" "osmode")<br/>xtblz (mapcar 'getvar xtblm)<br/>db (entget ent) r (cdr (assoc 40 db))<br/>po (cdr (assoc 10 db)) <br/>a0 (cdr (assoc 50 db))<br/>db (- (cdr (assoc 51 db)) a0)<br/>db (cond ((&lt; db 0) (+ (* 2.0 pi) db))<br/>(t db)<br/>)<br/>n (fix (/ db (atan (/ (sqrt (- (* 2.0 r h) (* h h))) (- r h)))))<br/>db (/ db n)<br/>)<br/>(mapcar 'setvar xtblm '(0 0))<br/>(command "_pline" (polar po a0 r))<br/>(repeat n (command (polar po (setq a0 (+ a0 db)) r)))<br/>(command "" "_matchprop" ent (entlast) "" "_erase" ent "" "redraw")<br/>(mapcar 'setvar xtblm xtblz)(princ)<br/>)</p><p>;测试程序<br/>(defun cc()<br/>(setq t0 (getvar "cdate"))<br/>(arc-&gt;pline (car (entsel "\n请选取要转化多段线的圆弧:")) 0.005)<br/>(princ (strcat "\n耗时：" (rtos (* 1000000 (- (getvar "cdate") t0) 2 3)) "秒"))<br/>(princ)<br/>)</p>

yjtdkj 发表于 2021-6-25 10:36:45

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

yjtdkj 发表于 2021-6-28 09:28:36

caocaosasd 发表于 2021-6-27 21:33
大神，有没有办法批量把选中的弧线分别直接替换成直线呢？就是弧变成弦，弦的形式是直线

(defun c:tt ()
(setq en (car (entsel)))
(setq pt1 (vlax-curve-getStartPoint en))
(setq pt2 (vlax-curve-getendPoint en))
(entmake
    (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2))
)
(entdel en)
(entlast)
)

caocaosasd 发表于 2021-6-27 21:33:56

yjtdkj 发表于 2021-6-26 06:33
把(defun cc ()改为(defun c:cc ()
然后在CAD里就可以用CC命令了，也可以改成你想要的

大神，有没有办法批量把选中的弧线分别直接替换成直线呢？就是弧变成弦，弦的形式是直线

nonsmall 发表于 2008-3-11 13:47:00

<p>这个程序楼主改进成为</p><p>圆弧多线段转pline会有用些吧?</p>

ninja37 发表于 2021-6-25 21:20:00

yjtdkj 发表于 2021-6-25 10:36
去掉了command命令，重新写了一遍，速度快多了

大师，这个程序 在cad里面是哪一个命令啊。

yjtdkj 发表于 2021-6-26 06:33:29

ninja37 发表于 2021-6-25 21:20
大师，这个程序 在cad里面是哪一个命令啊。

把(defun cc ()改为(defun c:cc ()
然后在CAD里就可以用CC命令了，也可以改成你想要的

ninja37 发表于 2021-6-27 12:33:19

yjtdkj 发表于 2021-6-26 06:33
把(defun cc ()改为(defun c:cc ()
然后在CAD里就可以用CC命令了，也可以改成你想要的

谢谢 已经在用了很好用

大尾巴狼 发表于 2021-11-26 09:21:16

很不错，要是能多选就更好了

lizhiqiang9801 发表于 2022-12-21 00:36:45

程序运行流畅能修改成框选就完美了
页: [1] 2
查看完整版本: [原创]圆弧转多段线