[原创]圆弧转多段线

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

;圆弧转多段线 ;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) )

小毛草 发表于 2025-3-9 12:09:12

可以试下这个程序，可以多选！;;;-----------------------------------------------------
;;; 功能：批量将圆弧转换为多段线（支持逆向圆弧）
;;;-----------------------------------------------------

(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)

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)
)

xyp1964 发表于 2025-3-9 12:25:16

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

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

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

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命令了，也可以改成你想要的

谢谢已经在用了很好用

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

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

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

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)
)

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

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

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

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

页: [1] 2

明经CAD社区's Archiver

[原创]圆弧转多段线