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