[原创]圆弧转多段线

依然小小鸟

谁能改为框选

依然小小鸟

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

有没有多段线转圆弧的插件呢

glcsq

谢谢楼主分享。

magicheno

感谢大佬分享

小毛草

可以试下这个程序，可以多选！

2. ;;;-----------------------------------------------------
   
3. ;;; 功能：批量将圆弧转换为多段线（支持逆向圆弧）
   
4. ;;;-----------------------------------------------------
   
5. 
   
6. (defun c:ARC2PL ( / *error* acadObj doc ss i ename oldVars h)
   
7.   ;; 错误处理函数
   
8.   (defun *error* (msg)
   
9.     (if doc (vla-endundomark doc))
   
10.     (if oldVars (mapcar 'setvar '("CMDECHO" "OSMODE") oldVars))
    
11.     (princ (strcat "\n错误: " msg))
    
12.   )
    
13.   
    
14.   (setq acadObj (vlax-get-acad-object)
    
15.         doc (vla-get-activedocument acadObj)
    
16.         oldVars (list (getvar "CMDECHO") (getvar "OSMODE"))) ; 修正变量存储方式
    
17.   
    
18.   (setvar "CMDECHO" 0)
    
19.   (setvar "OSMODE" 0)
    
20.   
    
21.   ;; 用户输入弓高（默认0.005）
    
22.   (initget 6)
    
23.   (setq h (getreal "\n输入弓高精度<0.005>: "))
    
24.   (if (not h) (setq h 0.005))
    
25.   
    
26.   (if (setq ss (ssget '((0 . "ARC"))))
    
27.     (progn
    
28.       (vla-startundomark doc)
    
29.       (setq i 0)
    
30.       (repeat (sslength ss)
    
31.         (setq ename (ssname ss i))
    
32.         (arc->polyline ename h)
    
33.         (setq i (1+ i))
    
34.       )
    
35.       (vla-endundomark doc)
    
36.       (princ (strcat "\n成功转换 " (itoa i) " 个圆弧"))
    
37.     )
    
38.     (princ "\n未选择任何圆弧")
    
39.   )
    
40.   (mapcar 'setvar '("CMDECHO" "OSMODE") oldVars)
    
41.   (princ)
    
42. )
    
43. 
    
44. ;;;-----------------------------------------------------
    
45. ;;; 核心转换函数
    
46. ;;; 参数：ename - 圆弧图元名
    
47. ;;;       h     - 最大允许弓高
    
48. ;;;-----------------------------------------------------
    
49. (defun arc->polyline (ename h / elst r pts)
    
50.   ;; 获取圆弧关键参数
    
51.   (setq elst (entget ename)
    
52.         r (cdr (assoc 40 elst)))
    
53.   
    
54.   ;; 计算顶点列表
    
55.   (setq pts (arc-divide ename h r)) ; 增加半径参数传递
    
56.   
    
57.   ;; 构建多段线数据
    
58.   (entmakex
    
59.     (append
    
60.       (list
    
61.         '(0 . "LWPOLYLINE")
    
62.         '(100 . "AcDbEntity")
    
63.         (assoc 8 elst)   ; 保留图层
    
64.         (if (assoc 62 elst) (assoc 62 elst) '(62 . 256)) ; 处理未设置颜色
    
65.         (if (assoc 6 elst) (assoc 6 elst) '(6 . "BYLAYER")) ; 处理未设置线型
    
66.         '(100 . "AcDbPolyline")
    
67.         (cons 90 (length pts))
    
68.         '(70 . 0)
    
69.         (if (assoc 38 elst) (assoc 38 elst) '(38 . 0.0)) ; 处理标高
    
70.         (if (assoc 210 elst) (assoc 210 elst) '(210 (0.0 0.0 1.0))) ; 默认法向量
    
71.       )
    
72.       (mapcar '(lambda (p) (cons 10 p)) pts) ; 简化坐标处理
    
73.     )
    
74.   )
    
75.   (entdel ename) ; 删除原始圆弧
    
76.   (princ)
    
77. )
    
78. 
    
79. ;;;-----------------------------------------------------
    
80. ;;; 圆弧分割算法（修正版）
    
81. ;;; 返回顶点坐标列表（包含起点和终点）
    
82. ;;;-----------------------------------------------------
    
83. (defun arc-divide (ename h r / startParam endParam totalAngle segAngle n pts param)
    
84.   (setq startParam (vlax-curve-getStartParam ename)
    
85.         endParam (vlax-curve-getEndParam ename)
    
86.         totalAngle (abs (- endParam startParam)))
    
87.   
    
88.   ;; 计算分段数（基于弓高公式）
    
89.   (if (> r h)
    
90.     (progn
    
91.       (setq segAngle (* 2 (acos (/ (- r h) r)))
    
92.       (setq n (max (fix (/ totalAngle segAngle)) 1))
    
93.       (setq segAngle (/ totalAngle n))
    
94.     )
    
95.     (setq n 1) ; 处理半径过小的情况
    
96.   )
    
97.   
    
98.   ;; 生成顶点参数表
    
99.   (setq pts (list (vlax-curve-getStartPoint ename)))
    
100.   (repeat (1- n)
     
101.     (setq param (+ startParam (* segAngle (length pts))))
     
102.     (setq pts (cons (vlax-curve-getPointAtParam ename param) pts))
     
103.   )
     
104.   (reverse (cons (vlax-curve-getEndPoint ename) pts))
     
105. )
     
106. 
     
107. ;;;-----------------------------------------------------
     
108. ;;; 辅助函数：反余弦计算（修正括号匹配）
     
109. ;;;-----------------------------------------------------
     
110. (defun acos (x)
     
111.   (cond
     
112.     ((>= x 1.0) 0.0)
     
113.     ((<= x -1.0) pi)
     
114.     (t (atan (sqrt (- 1.0 (* x x))) x)
     
115.   )
     
116. )
     
117. 
     
118. (princ "\n圆弧转多段线命令已加载，请输入 ARC2PL 执行")
     
119. (princ)

;;;-----------------------------------------------------<br /> ;;; 功能：批量将圆弧转换为多段线（支持逆向圆弧）<br /> ;;;-----------------------------------------------------<br /> <br /> (defun c:ARC2PL ( / *error* acadObj doc ss i ename oldVars h)<br />   ;; 错误处理函数<br />   (defun *error* (msg)<br />     (if doc (vla-endundomark doc))<br />     (if oldVars (mapcar 'setvar '("CMDECHO" "OSMODE") oldVars))<br />     (princ (strcat "\n错误: " msg))<br />   )<br />   <br />   (setq acadObj (vlax-get-acad-object)<br />         doc (vla-get-activedocument acadObj)<br />         oldVars (list (getvar "CMDECHO") (getvar "OSMODE"))) ; 修正变量存储方式<br />   <br />   (setvar "CMDECHO" 0)<br />   (setvar "OSMODE" 0)<br />   <br />   ;; 用户输入弓高（默认0.005）<br />   (initget 6)<br />   (setq h (getreal "\n输入弓高精度<0.005>: "))<br />   (if (not h) (setq h 0.005))<br />   <br />   (if (setq ss (ssget '((0 . "ARC"))))<br />     (progn<br />       (vla-startundomark doc)<br />       (setq i 0)<br />       (repeat (sslength ss)<br />         (setq ename (ssname ss i))<br />         (arc->polyline ename h)<br />         (setq i (1+ i))<br />       )<br />       (vla-endundomark doc)<br />       (princ (strcat "\n成功转换 " (itoa i) " 个圆弧"))<br />     )<br />     (princ "\n未选择任何圆弧")<br />   )<br />   (mapcar 'setvar '("CMDECHO" "OSMODE") oldVars)<br />   (princ)<br /> )<br /> <br /> ;;;-----------------------------------------------------<br /> ;;; 核心转换函数<br /> ;;; 参数：ename - 圆弧图元名<br /> ;;;       h     - 最大允许弓高<br /> ;;;-----------------------------------------------------<br /> (defun arc->polyline (ename h / elst r pts)<br />   ;; 获取圆弧关键参数<br />   (setq elst (entget ename)<br />         r (cdr (assoc 40 elst)))<br />   <br />   ;; 计算顶点列表<br />   (setq pts (arc-divide ename h r)) ; 增加半径参数传递<br />   <br />   ;; 构建多段线数据<br />   (entmakex<br />     (append<br />       (list<br />         '(0 . "LWPOLYLINE")<br />         '(100 . "AcDbEntity")<br />         (assoc 8 elst)   ; 保留图层<br />         (if (assoc 62 elst) (assoc 62 elst) '(62 . 256)) ; 处理未设置颜色<br />         (if (assoc 6 elst) (assoc 6 elst) '(6 . "BYLAYER")) ; 处理未设置线型<br />         '(100 . "AcDbPolyline")<br />         (cons 90 (length pts))<br />         '(70 . 0)<br />         (if (assoc 38 elst) (assoc 38 elst) '(38 . 0.0)) ; 处理标高<br />         (if (assoc 210 elst) (assoc 210 elst) '(210 (0.0 0.0 1.0))) ; 默认法向量<br />       )<br />       (mapcar '(lambda (p) (cons 10 p)) pts) ; 简化坐标处理<br />     )<br />   )<br />   (entdel ename) ; 删除原始圆弧<br />   (princ)<br /> )<br /> <br /> ;;;-----------------------------------------------------<br /> ;;; 圆弧分割算法（修正版）<br /> ;;; 返回顶点坐标列表（包含起点和终点）<br /> ;;;-----------------------------------------------------<br /> (defun arc-divide (ename h r / startParam endParam totalAngle segAngle n pts param)<br />   (setq startParam (vlax-curve-getStartParam ename)<br />         endParam (vlax-curve-getEndParam ename)<br />         totalAngle (abs (- endParam startParam)))<br />   <br />   ;; 计算分段数（基于弓高公式）<br />   (if (> r h)<br />     (progn<br />       (setq segAngle (* 2 (acos (/ (- r h) r)))<br />       (setq n (max (fix (/ totalAngle segAngle)) 1))<br />       (setq segAngle (/ totalAngle n))<br />     )<br />     (setq n 1) ; 处理半径过小的情况<br />   )<br />   <br />   ;; 生成顶点参数表<br />   (setq pts (list (vlax-curve-getStartPoint ename)))<br />   (repeat (1- n)<br />     (setq param (+ startParam (* segAngle (length pts))))<br />     (setq pts (cons (vlax-curve-getPointAtParam ename param) pts))<br />   )<br />   (reverse (cons (vlax-curve-getEndPoint ename) pts))<br /> )<br /> <br /> ;;;-----------------------------------------------------<br /> ;;; 辅助函数：反余弦计算（修正括号匹配）<br /> ;;;-----------------------------------------------------<br /> (defun acos (x)<br />   (cond<br />     ((>= x 1.0) 0.0)<br />     ((<= x -1.0) pi)<br />     (t (atan (sqrt (- 1.0 (* x x))) x)<br />   )<br /> )<br /> <br /> (princ "\n圆弧转多段线命令已加载，请输入 ARC2PL 执行")<br /> (princ)

xyp1964

1. (defun c:tt ()
   
2.   "圆弧转多段线"
   
3.   (princ "\n选择圆弧实体<退出>: ")
   
4.   (if (setq ss (ssget '((0 . "arc"))))
   
5.     (progn
   
6.       (setvar "PEDITACCEPT" 1)
   
7.       (command "pedit" "m" ss "" "")
   
8.     )
   
9.   )
   
10.   (princ)
    
11. )

(defun c:tt ()<br />   "圆弧转多段线"<br />   (princ "\n选择圆弧实体<退出>: ")<br />   (if (setq ss (ssget '((0 . "arc"))))<br />     (progn<br />       (setvar "PEDITACCEPT" 1)<br />       (command "pedit" "m" ss "" "")<br />     )<br />   )<br />   (princ)<br /> )