[原创]圆弧转多段线

gao6690

;圆弧转多段线
;h为弓高（即弦中心至相对应弧之中心的距离）
;它用来描述以弦代弧的光滑程度，一般化取0.005mm(图上距离)即可
(defun arc->pline(ent h / xtblm xtblz db r po a0 h n)
(setq xtblm '("cmdecho" "osmode")
xtblz (mapcar 'getvar xtblm)
db (entget ent) r (cdr (assoc 40 db))
po (cdr (assoc 10 db))
a0 (cdr (assoc 50 db))
db (- (cdr (assoc 51 db)) a0)
db (cond ((< db 0) (+ (* 2.0 pi) db))
(t db)
)
n (fix (/ db (atan (/ (sqrt (- (* 2.0 r h) (* h h))) (- r h)))))
db (/ db n)
)
(mapcar 'setvar xtblm '(0 0))
(command "_pline" (polar po a0 r))
(repeat n (command (polar po (setq a0 (+ a0 db)) r)))
(command "" "_matchprop" ent (entlast) "" "_erase" ent "" "redraw")
(mapcar 'setvar xtblm xtblz)(princ)
)

;测试程序
(defun cc()
(setq t0 (getvar "cdate"))
(arc->pline (car (entsel "\n请选取要转化多段线的圆弧:")) 0.005)
(princ (strcat "\n耗时：" (rtos (* 1000000 (- (getvar "cdate") t0) 2 3)) "秒"))
(princ)
)

yjtdkj

去掉了command命令，重新写了一遍，速度快多了

1. ;圆弧转多段线
   
2. ;h为弓高（即弦中心至相对应弧之中心的距离）
   
3. ;它用来描述以弦代弧的光滑程度，一般化取0.005mm(图上距离)即可
   
4. (defun arc->pline (en h / xtblm xtblz ALEN ENT LEN LST N PT PTLST R SUM)
   
5.   (setq #t0# (getvar "cdate"))
   
6.   (setq        xtblm '("cmdecho" "osmode")
   
7.         xtblz (mapcar 'getvar xtblm)
   
8.         r     (yj-dxf 40 en)
   
9.         len   (vlax-curve-getDistAtPoint en (vlax-curve-getEndPoint en))
   
10.         alen  (* (atan (/ (sqrt (- (* 2.0 r h) (* h h))) (- r h))) r)
    
11.         n     (fix (/ len alen))
    
12.         alen  (/ len n)
    
13.         sum   alen
    
14.         ptlst '()
    
15.   )
    
16.   (repeat n
    
17.     (setq pt (vlax-curve-getpointatdist en sum))
    
18.     (setq ptlst (append ptlst (list (cons 10 pt)(cons 40 0)(cons 41 0)(cons 42 0)) ))
    
19.     (setq sum (+ sum alen))
    
20.     )
    
21.   (setq ent (entget en))
    
22.   (setq lst '((0 . "LWPOLYLINE")))
    
23.      (foreach x '(100 67 410 8 62 6 370)
    
24.        (if (assoc x
    
25.                   ent
    
26.            ) ;_  assoc
    
27.          (setq lst (cons (assoc x ent) lst))
    
28.        ) ;_  if
    
29.      ) ;_  foreach
    
30.      (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
    
31.      (entmakex
    
32.        (append
    
33.          (reverse lst)
    
34.          (list
    
35.            '(100 . "AcDbPolyline")
    
36.            (cons 90 (1+ n))
    
37.            '(70 . 0)
    
38.            (cons 38 (cadddr (assoc 10 ent)))
    
39.            (cons
    
40.              10
    
41.              (vlax-curve-getStartPoint en
    
42.              ) ;_  reverse
    
43.            ) ;_  cons
    
44.            '(40 . 0)
    
45.            '(41 . 0)
    
46.            '(42 . 0)
    
47.          )
    
48.          ptlst
    
49.          (list
    
50.            (assoc 210 ent)
    
51.          ) ;_  list
    
52.        ) ;_  append
    
53.      ) ;_  entmakex
    
54.      ;(Vlax-Put-Property (Vlax-Ename->Vla-Object (entlast)) 'Color 1)
    
55.      (entdel en)
    
56.      (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
    
57.   (mapcar 'setvar xtblm xtblz)
    
58.   (princ)
    
59. )
    
60. ;;;按指组码找出全图元的组码值
    
61.     (defun yj-dxf (key ename) (cdr (assoc key (entget ename))))   
    
62. ;测试程序
    
63. (defun cc ()
    
64.   (arc->pline (car (entsel "\n请选取要转化多段线的圆弧:"))
    
65.               0.05
    
66.   )
    
67.   (princ
    
68.     (strcat "\n耗时："
    
69.             (rtos (* 1000000 (- (getvar "cdate") #t0#) 2 3))
    
70.             "秒"
    
71.     )
    
72.   )
    
73.   (princ)
    
74. )
    

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

yjtdkj

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

1. (defun c:tt ()
   
2.   (setq en (car (entsel)))
   
3.   (setq pt1 (vlax-curve-getStartPoint en))
   
4.   (setq pt2 (vlax-curve-getendPoint en))
   
5.   (entmake
   
6.     (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2))
   
7.   )
   
8.   (entdel en)
   
9.   (entlast)
   
10. )

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

caocaosasd

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

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

nonsmall

这个程序楼主改进成为

圆弧多线段转pline会有用些吧?

ninja37

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

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

yjtdkj

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

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

ninja37

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

谢谢 已经在用了  很好用

大尾巴狼

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

lizhiqiang9801

程序运行流畅  能修改成框选就完美了