明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1612|回复: 18

[提问] 求大佬一个将断口连接上

[复制链接]
发表于 2025-2-10 10:30:25 | 显示全部楼层 |阅读模式
20明经币

附件: 您需要 登录 才可以下载或查看,没有账号?注册
"觉得好,就打赏"
还没有人打赏,支持一下
回复

使用道具 举报

发表于 2025-2-10 13:46:43 | 显示全部楼层
不就是虚线改实线吗
回复

使用道具 举报

 楼主| 发表于 2025-2-13 08:32:32 | 显示全部楼层
lht 发表于 2025-2-10 13:46
不就是虚线改实线吗

不是的,是打断需要连起来
回复

使用道具 举报

发表于 2025-2-13 20:42:06 | 显示全部楼层
::直线问题可以完美解决,圆弧问题请教各路高手,我只求3个明经币的悬赏。
;;框选共线直线并批量连接:mmjj
;;感谢明经CAD社区!感谢ucuc2003!http://bbs.mjtd.com/forum.php?mo ... C%BD%D3%B6%CF%CF%DF
;;返回共线四点最近2点
(defun minlong (p1 p2 p3 p4)
  (setq ptlst '(p1 p2 p3 p4))
  (setq n '())
  (setq i -1)
  (while (setq a (nth (setq i (1+ i)) ptlst)) ;返回表的第N个元素
    (setq b (cdr (member a ptlst)))        ;返回a后面的剩余元素,包括a,并去掉a的表
    (setq n (append (mapcar '(lambda (x) (list a x)) b) n))
  )
  (setq
    a1 (mapcar '(lambda        (x)
                  (list        (distance (vl-symbol-value (car x))
                                  (vl-symbol-value (cadr x))
                        )
                        x
                  )
                )
               (reverse n)
       )
  )
  (setq a2 (vl-sort a1 '(lambda (x y) (< (car x) (car y)))))
  (setq a3 (car a2))
  (setq a4 (cadr a3))
)
;返回共线四点最远2点
(defun maxlong (p1 p2 p3 p4)
  (setq ptlst '(p1 p2 p3 p4))
  (setq n '())
  (setq i -1)
  (while (setq a (nth (setq i (1+ i)) ptlst)) ;返回表的第N个元素
    (setq b (cdr (member a ptlst)))        ;返回a后面的剩余元素,包括a,并去掉a的表
    (setq n (append (mapcar '(lambda (x) (list a x)) b) n))
  )
  (setq
    a1 (mapcar '(lambda        (x)
                  (list        (distance (vl-symbol-value (car x))
                                  (vl-symbol-value (cadr x))
                        )
                        x
                  )
                )
               (reverse n)
       )
  )
  (setq a2 (vl-sort a1 '(lambda (x y) (> (car x) (car y)))))
  (setq a3 (car a2))
  (setq a4 (cadr a3))
)
;检测3点是否共线
(defun pppl (pp1 pp2 pp3)
  (setq dis1 (distance pp1 pp2))
  (setq dis2 (distance pp2 pp3))
  (setq dis3 (distance pp1 pp3))
  (if (or (<= (abs (- dis1 (+ dis2 dis3))) 0.000001)
          (<= (abs(- dis2 (+ dis1 dis3))) 0.000001)
          (<= (abs(- dis3 (+ dis2 dis1))) 0.000001)

      )
    1
    nil
  )

)

;框选共线直线并批量连接
(defun C:mmjj (/ ss flag n1 n2 ln1 pn1 p1 p2 la ln2 pn2 p3 p4 pp px1 px2 lk la)
  (command "._UNDO" "_BEGIN")
  (princ "\n框选共线直线并批量连接,请选择对象:")
  (setq ss (ssget '((0 . "LINE"))))
  (setq flag 0)                                ;选择集变动标志
  (setq n1 0)
  (while (< n1 (sslength ss))                ;读取选择集图元数量
    (setq n2 (+ n1 1))
    (while (< n2 (sslength ss))
      (setq ln1 (ssname ss n1))                ;把选择集第一个图元名赋给变量ln
      (setq pn1 (entget ln1))                ;获取图原名的定义数据
      (setq p1 (cdr (assoc 10 pn1)))        ;直线起点
      (setq p2 (cdr (assoc 11 pn1)))        ;直线终点
      (setq la (assoc 8 pn1))           ;直线所在图层
      (setq ln2 (ssname ss n2))
      (setq pn2 (entget ln2))
      (setq p3 (cdr (assoc 10 pn2)))        ;直线起点
      (setq p4 (cdr (assoc 11 pn2)))        ;直线终点
                                                                   ;判断4点共线
      (if (and (pppl p1 p2 p3) (pppl p1 p2 p4))
        (progn
          (setq qq (minlong p1 p2 p3 p4)) ;返回共线4点中距离最近的2点
          (setq        py1 (vl-symbol-value (car qq)) ;第1点
                py2 (vl-symbol-value (cadr qq)) ;第2点
               dis4 (distance py1 py2)
          )
                  (setq pp (maxlong p1 p2 p3 p4)) ;返回共线4点中距离最远的2点
          (setq        px1 (vl-symbol-value (car pp)) ;第1点
                px2 (vl-symbol-value (cadr pp)) ;第2点
          )
      (if (and (<= dis4 4.1)
                   (> dis4 3.1))
        (progn
          (setq
            lk (entmakex
                 (list '(0 . "LINE") (cons 10 px1) la (cons 11 px2))
               )
          )                                ;生成1到2的直线
          (entdel ln1)                        ;删除共线直线lm
          (entdel ln2)                        ;删除共线直线ln
          (ssdel ln1 ss)                ;删除选择集中共线图元lm
          (ssdel ln2 ss)                ;删除选择集中共线图元ln
          (ssadd lk ss)                        ;增加新生成直线到选择集末尾
          (setq flag 1)
        )
      )))
      (if (= flag 1)
        (progn
          (setq n2 (+ n1 1))
          (setq flag 0)
        )
        (setq n2 (+ n2 1))
      )
    )
    (setq n1 (+ n1 1))
  )
  (command "._UNDO" "_END")
  (princ)
)

评分

参与人数 1明经币 +1 收起 理由
世井 + 1 赞一个!

查看全部评分

回复

使用道具 举报

发表于 2025-2-15 13:09:59 | 显示全部楼层
;;试试这段代码连接圆弧估计很爽
;;;** 批量连接圆弧断口 By GEGEYANG88 2025.02.15 命令: tt **
;;
;; Copyright (c)2025 GEGEYANG88
;; 版权所有  GEGEYANG88
;;
;;作者保留本程序的一切权利,但你可以自由拷贝与复制、修改本程序用于非商业目的。
;;作者尽力将本程序做得完善,但不会因本软件的错失而造成的损失承担任何责任。
;;

(defun c:tt (/ ss arc ent center-pt radius start-angle end-angle start-pt end-pt
              found group groups total-arcs total-groups i j current-arc next-arc
              current-start-pt next-end-pt current-end-pt next-start-pt dist ssarcs
              last-arc first-arc last-dist last-start-pt last-end-pt first-start-pt first-end-pt)
  (vl-load-com)
  (command "._UNDO" "_BEGIN")
  ;; 提示用户选择多个圆弧
  (prompt "\n选择多个圆弧: ")
  (setq ss (ssget '((0 . "ARC")))) ;; 选择所有类型为ARC的实体

  ;; 检查是否有选中的圆弧
  (if ss
    (progn
      ;; 初始化分组表
      (setq groups '())
      (setq total-arcs 0)
      (setq total-groups 0)
      (setvar "CLAYER" "layer2")
      ;; 遍历选中的每一个圆弧
      (setq i 0)
      (while (< i (sslength ss))
        (setq arc (ssname ss i)) ;; 获取第i个圆弧实体
        (setq ent (entget arc)) ;; 获取圆弧的实体数据

        ;; 获取圆弧的中心点、半径、起始角度和终止角度
        (setq center-pt (cdr (assoc 10 ent))) ;; 中心点
        (setq radius (cdr (assoc 40 ent))) ;; 半径
        (setq start-angle (cdr (assoc 50 ent))) ;; 起始角度
        (setq end-angle (cdr (assoc 51 ent))) ;; 终止角度

        ;; 计算圆弧的起点和终点坐标
        (setq start-pt (polar center-pt start-angle radius)) ;; 起点
        (setq end-pt (polar center-pt end-angle radius)) ;; 终点

        ;; 查找是否已存在相同圆心和半径的分组
        (setq found nil)
        (foreach group groups
          (if (and (equal center-pt (car group) 1e-4) ;; 比较圆心(允许微小误差)
                  (equal radius (cadr group) 1e-4)) ;; 比较半径(允许微小误差)
            (progn
              ;; 将圆弧添加到现有分组
              (setq found t)
              (setq groups (subst (list (car group) (cadr group)
                                         (cons (list arc start-pt end-pt) (caddr group)))
                                  group groups))
            )
          )
        )

        ;; 如果没有找到匹配的分组,则创建新分组
        (if (not found)
          (setq groups (cons (list center-pt radius (list (list arc start-pt end-pt))) groups))
        )

        ;; 继续处理下一个圆弧
        (setq i (1+ i))
      )

      ;; 计算总的圆弧数量和组数
      (setq total-arcs (sslength ss))
      (setq total-groups (length groups))

      ;; 输出每个组的圆弧数量
      (prompt (strcat "\n总圆弧数量: " (itoa total-arcs)))
      (prompt (strcat "\n总组数: " (itoa total-groups)))

      ;; 遍历每个分组
      (foreach group groups
        (setq group-arcs (caddr group)) ;; 获取分组中的圆弧列表
        (setq group-count (length group-arcs)) ;; 获取分组中的圆弧数量

        ;; 如果分组中的圆弧数量大于1,则检查并调整圆弧的终点
        (if (> group-count 1)
          (progn
            ;; 遍历分组中的圆弧
            (setq j 0)
            ;; 处理中间的圆弧
            (while (< j (1- group-count))
              (setq current-arc (nth j group-arcs)) ;; 当前圆弧
              (setq next-arc (nth (1+ j) group-arcs)) ;; 下一个圆弧

              ;; 获取当前圆弧的起点和下一个圆弧的终点
              (setq current-start-pt (cadr current-arc))
              (setq next-end-pt (caddr next-arc))
              ;; 获取当前圆弧的终点和下一个圆弧的起点
              (setq current-end-pt (caddr current-arc))
              (setq next-start-pt (cadr next-arc))
              ;; 计算两点之间的距离
              (setq dist (distance current-end-pt next-start-pt))

              ;; 如果距离在3和4之间,则调整当前圆弧的终点
              (if (and (>= dist 3.9) (<= dist 4.1))
                (progn
                  (vl-cmdf "ARC" current-start-pt current-end-pt next-end-pt) ; 画圆弧
                )
              )
              ;; 继续处理下一个圆弧
              (setq j (1+ j))
            )

            ;; 针对最后一个对象和原始第一个对象的处理
            (setq last-arc (nth (1- group-count) group-arcs)) ;; 最后一个圆弧
            (setq last-start-pt (cadr last-arc))
            (setq last-end-pt (caddr last-arc))
            (setq first-arc (nth 0 group-arcs)) ;; 原始第一个圆弧
            (setq first-start-pt (cadr first-arc))
            (setq first-end-pt (caddr first-arc))
            (setq last-dist (distance last-end-pt first-start-pt))

            (if (and (>= last-dist 3.9) (<= last-dist 4.1))
              (progn
                (vl-cmdf "ARC" last-start-pt last-end-pt first-start-pt) ; 画圆弧
              )
            )
          )
        )
      )
    )
    (prompt "\n未选择任何圆弧。")
  )
(setq ssarcs (ssget "_X" '((0 . "ARC"))))
(if ssarcs
  (vl-cmdf "-overkill" ssarcs "" "")
  (princ "没有找到任何弧形对象。"))
  (command "._UNDO" "_END")
  (princ) ;; 静默退出
)

点评

setvar "CLAYER" "layer2") 错误  发表于 2025-2-15 13:30

评分

参与人数 1明经币 +1 收起 理由
世井 + 1

查看全部评分

回复

使用道具 举报

发表于 2025-2-15 13:44:56 | 显示全部楼层
;;这个程序暂时满足世井的例图,其他情况可以自己修改
;;注意把  (command "._UNDO" "_BEGIN")放到后面去
  (vl-load-com)
  ;; 提示用户选择多个圆弧
  (prompt "\n选择多个圆弧: ")
  (setq ss (ssget '((0 . "ARC")))) ;; 选择所有类型为ARC的实体
  (command "._UNDO" "_BEGIN")

评分

参与人数 1明经币 +1 收起 理由
世井 + 1 很给力!

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2025-2-15 15:01:30 | 显示全部楼层
GEGEYANG88 发表于 2025-2-15 13:09
;;试试这段代码连接圆弧估计很爽
;;;** 批量连接圆弧断口 By GEGEYANG88 2025.02.15 命令: tt **
;;

3条圆弧的好像不行,原来的线应该删除掉
回复

使用道具 举报

发表于 2025-2-15 16:03:10 | 显示全部楼层
;;新版本** 批量连接圆弧断口 **
;;修正了图层处理错误并加快了速度效率
;;;** 批量连接圆弧断口 By GEGEYANG88 2025.02.15 命令: tt **
;;
;; Copyright (c)2025 GEGEYANG88
;; 版权所有  GEGEYANG88
;;
;;作者保留本程序的一切权利,但你可以自由拷贝与复制、修改本程序用于非商业目的。
;;作者尽力将本程序做得完善,但不会因本软件的错失而造成的损失承担任何责任。
;;

(defun c:tt (/ ss arc ent center-pt radius start-angle end-angle start-pt end-pt
              found group groups total-arcs total-groups i j current-arc next-arc
              current-start-pt next-end-pt current-end-pt next-start-pt dist ssarcs
              last-arc first-arc last-dist last-start-pt last-end-pt first-start-pt first-end-pt
              first-arcer first-arc-ent first-arc-layer)
  (vl-load-com)
  (command "._UNDO" "_BEGIN")

  ;; 提示用户选择多个圆弧
  (prompt "\n选择多个圆弧: ")
  (setq ss (ssget '((0 . "ARC")))) ;; 选择所有类型为ARC的实体

  (setvar "cmdecho" 0);_关闭命令提示
  ;; 检查是否有选中的圆弧
  (if ss
    (progn

    ;; 记录当前图层
    (setq original-layer (getvar "CLAYER"))
   
    ;; 获取第一个圆弧的图层
    (setq first-arcer (ssname ss 0)) ;; 获取第一个圆弧实体
    (setq first-arc-ent (entget first-arcer)) ;; 获取圆弧的实体数据
    (setq first-arc-layer (cdr (assoc 8 first-arc-ent))) ;; 获取圆弧的图层

    ;; 强制设置当前图层为第一个圆弧的图层
    (setvar "CLAYER" first-arc-layer)

      ;; 初始化分组表
      (setq groups '())
      (setq total-arcs 0)
      (setq total-groups 0)

      ;; 遍历选中的每一个圆弧
      (setq i 0)
      (while (< i (sslength ss))
        (setq arc (ssname ss i)) ;; 获取第i个圆弧实体
        (setq ent (entget arc)) ;; 获取圆弧的实体数据

        ;; 获取圆弧的中心点、半径、起始角度和终止角度
        (setq center-pt (cdr (assoc 10 ent))) ;; 中心点
        (setq radius (cdr (assoc 40 ent))) ;; 半径
        (setq start-angle (cdr (assoc 50 ent))) ;; 起始角度
        (setq end-angle (cdr (assoc 51 ent))) ;; 终止角度

        ;; 计算圆弧的起点和终点坐标
        (setq start-pt (polar center-pt start-angle radius)) ;; 起点
        (setq end-pt (polar center-pt end-angle radius)) ;; 终点

        ;; 查找是否已存在相同圆心和半径的分组
        (setq found nil)
        (foreach group groups
          (if (and (equal center-pt (car group) 1e-4) ;; 比较圆心(允许微小误差)
                  (equal radius (cadr group) 1e-4)) ;; 比较半径(允许微小误差)
            (progn
              ;; 将圆弧添加到现有分组
              (setq found t)
              (setq groups (subst (list (car group) (cadr group)
                                         (cons (list arc start-pt end-pt) (caddr group)))
                                  group groups))
            )
          )
        )

        ;; 如果没有找到匹配的分组,则创建新分组
        (if (not found)
          (setq groups (cons (list center-pt radius (list (list arc start-pt end-pt))) groups))
        )

        ;; 继续处理下一个圆弧
        (setq i (1+ i))
      )

      ;; 计算总的圆弧数量和组数
      (setq total-arcs (sslength ss))
      (setq total-groups (length groups))

      ;; 输出每个组的圆弧数量
     ;; (prompt (strcat "\n总圆弧数量: " (itoa total-arcs)))
     ;; (prompt (strcat "\n总组数: " (itoa total-groups)))

      ;; 遍历每个分组
      (foreach group groups
        (setq group-arcs (caddr group)) ;; 获取分组中的圆弧列表
        (setq group-count (length group-arcs)) ;; 获取分组中的圆弧数量

        ;; 如果分组中的圆弧数量大于1,则检查并调整圆弧的终点
        (if (> group-count 1)
          (progn
            ;; 遍历分组中的圆弧
            (setq j 0)
            ;; 处理中间的圆弧
            (while (< j (1- group-count))
              (setq current-arc (nth j group-arcs)) ;; 当前圆弧
              (setq next-arc (nth (1+ j) group-arcs)) ;; 下一个圆弧

              ;; 获取当前圆弧的起点和下一个圆弧的终点
              (setq current-start-pt (cadr current-arc))
              (setq next-end-pt (caddr next-arc))
              ;; 获取当前圆弧的终点和下一个圆弧的起点
              (setq current-end-pt (caddr current-arc))
              (setq next-start-pt (cadr next-arc))
              ;; 计算两点之间的距离
              (setq dist (distance current-end-pt next-start-pt))

              ;; 如果距离在3和4之间,则调整当前圆弧的终点
              (if (and (>= dist 3.9) (<= dist 4.1))
                (progn
                  (vl-cmdf "ARC" current-start-pt current-end-pt next-end-pt) ; 画圆弧
                )
              )
              ;; 继续处理下一个圆弧
              (setq j (1+ j))
            )

            ;; 针对最后一个对象和原始第一个对象的处理
            (setq last-arc (nth (1- group-count) group-arcs)) ;; 最后一个圆弧
            (setq last-start-pt (cadr last-arc))
            (setq last-end-pt (caddr last-arc))
            (setq first-arc (nth 0 group-arcs)) ;; 原始第一个圆弧
            (setq first-start-pt (cadr first-arc))
            (setq first-end-pt (caddr first-arc))
            (setq last-dist (distance last-end-pt first-start-pt))

            (if (and (>= last-dist 3.9) (<= last-dist 4.1))
              (progn
                (vl-cmdf "ARC" last-start-pt last-end-pt first-start-pt) ; 画圆弧
              )
            )
          )
        )
      )
    )
    (prompt "\n未选择任何圆弧。")
  )
(setq ssarcs (ssget "_X" '((0 . "ARC"))))
(if ssarcs
  (vl-cmdf "-overkill" ssarcs "" "")
  (princ "没有找到任何弧形对象。"))
    ;; 恢复原来的图层
  (setvar "CLAYER" original-layer)
  (setvar "cmdecho" 1);_打开命令提示
  (command "._UNDO" "_END")
  (princ) ;; 静默退出
)
回复

使用道具 举报

发表于 2025-2-15 16:05:37 | 显示全部楼层
最好先打开OVERKILL命令,勾选全部选项。

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
回复

使用道具 举报

 楼主| 发表于 2025-2-15 19:35:48 | 显示全部楼层
GEGEYANG88 发表于 2025-2-15 16:05
最好先打开OVERKILL命令,勾选全部选项。

用AI写的,也不行
(defun c:TT (/ *error* ss tolerance process-ent)
  (vl-load-com)
  (setq tolerance 1e-4) ; 几何容差值(0.0001单位)
  
  ;; 错误处理函数
  (defun *error* (msg)
    (princ (strcat "\n错误: " msg))
    (princ)
  )
  
  ;; 主处理函数
  (defun process-ent (ent / objType)
    (setq objType (cdr (assoc 0 (entget ent))))
    (cond
      ((= objType "LINE")  (process-line ent))
      ((= objType "ARC")   (process-arc ent))
      ((= objType "CIRCLE")(process-circle ent))
    )
  )

  ;; 处理直线(兼容2007版本的选择集处理)
  (defun process-line (ent / elst p1 p2 ss-lines lines new-line)
    (setq elst (entget ent))
    (setq p1 (cdr (assoc 10 elst)))
    (setq p2 (cdr (assoc 11 elst)))
   
    ;; 改进的选择集过滤方式
    (setq ss-lines (ssget "_X" '((0 . "LINE"))))
    (setq lines
      (vl-remove-if-not
        '(lambda (x)
          (or
            (and
              (equal p1 (cdr (assoc 10 (entget x))) tolerance)
              (equal p2 (cdr (assoc 11 (entget x))) tolerance))
            (and
              (equal p2 (cdr (assoc 10 (entget x))) tolerance)
              (equal p1 (cdr (assoc 11 (entget x))) tolerance))
          )
        )
        (get-entities ss-lines) ;; 改用自定义实体获取函数
      )
    )
   
    ;; 创建新直线并删除旧线段
    (if (> (length lines) 1)
      (progn
        (setq new-line
          (entmakex
            (list
              '(0 . "LINE")
              (cons 10 (cdr (assoc 10 (entget (car lines)))))
              (cons 11 (cdr (assoc 11 (entget (last lines)))))
            )
          )
        )
        (foreach x lines (entdel x))
        new-line
      )
    )
  )

  ;; 处理圆弧(增加2007角度处理兼容性)
  (defun process-arc (ent / elst center radius ss-arcs arcs merged)
    (setq elst (entget ent))
    (setq center (cdr (assoc 10 elst)))
    (setq radius (cdr (assoc 40 elst)))
   
    ;; 改进的圆弧选择方式
    (setq ss-arcs (ssget "_X" '((0 . "ARC"))))
    (setq arcs
      (vl-remove-if-not
        '(lambda (x)
          (and
            (equal center (cdr (assoc 10 (entget x))) tolerance)
            (equal radius (cdr (assoc 40 (entget x))) tolerance)
          )
        )
        (get-entities ss-arcs) ;; 改用自定义实体获取函数
      )
    )
   
    ;; 合并圆弧
    (setq merged (merge-arcs arcs))
    (if merged
      (progn
        (foreach x arcs (entdel x))
        (entmake merged)
      )
    )
  )

  ;; 兼容2007的圆弧合并算法
  (defun merge-arcs (arcs / angles-list full-circle)
    (setq angles-list
      (mapcar
        '(lambda (x / elst)
          (setq elst (entget x))
          (list
            (fix-angle (cdr (assoc 50 elst))) ;; 增加角度修正
            (fix-angle (cdr (assoc 51 elst)))
          )
        )
        arcs
      )
    )
   
    ;; 检查完整圆(兼容2007的精度问题)
    (setq full-circle
      (vl-some
        '(lambda (a)
          (or
            (and
              (equal (car a) 0.0 tolerance)
              (equal (cadr a) (* 2 pi) tolerance)
            )
            (> (abs (- (cadr a) (car a))) (- (* 2 pi) tolerance)) ;; 增加容差判断
          )
        )
        angles-list
      )
    )
   
    (if full-circle
      (list
        '(0 . "CIRCLE")
        (cons 10 (cdr (assoc 10 (entget (car arcs)))))
        (cons 40 (cdr (assoc 40 (entget (car arcs)))))
      (progn
        (setq angles-list (sort-angles angles-list)) ;; 改用自定义排序
        (list
          '(0 . "ARC")
          (cons 10 (cdr (assoc 10 (entget (car arcs)))))
          (cons 40 (cdr (assoc 40 (entget (car arcs)))))
          (cons 50 (caar angles-list))
          (cons 51 (cadr (last angles-list)))
        )
      )
    )
  ))

  ;; 处理圆(改进圆弧检测逻辑)
  (defun process-circle (ent / elst center radius ss-arcs arcs)
    (setq elst (entget ent))
    (setq center (cdr (assoc 10 elst)))
    (setq radius (cdr (assoc 40 elst)))
   
    ;; 改进的圆弧检测
    (setq ss-arcs (ssget "_X" '((0 . "ARC"))))
    (setq arcs
      (vl-remove-if-not
        '(lambda (x)
          (and
            (equal center (cdr (assoc 10 (entget x))) tolerance)
            (equal radius (cdr (assoc 40 (entget x))) tolerance)
            (or
              (equal (fix-angle (cdr (assoc 50 (entget x)))) 0.0 tolerance) ;; 使用修正角度
              (equal (fix-angle (cdr (assoc 51 (entget x)))) (* 2 pi) tolerance)
            )
          )
        )
        (get-entities ss-arcs) ;; 改用自定义实体获取函数
      )
    )
   
    ;; 重建完整圆
    (if arcs
      (progn
        (foreach x arcs (entdel x))
        (entmake
          (list
            '(0 . "CIRCLE")
            (cons 10 center)
            (cons 40 radius)
          )
        )
      )
    )
  )

  ;; 自定义函数 --------------------------------------------------
  ;; 修正角度到0-2π范围(兼容2007)
  (defun fix-angle (a)
    (cond
      ((< a 0) (+ (* 2 pi) (rem a (* 2 pi))))
      (t (rem a (* 2 pi)))
    )
  )

  ;; 安全获取实体列表(兼容2007选择集处理)
  (defun get-entities (ss / i lst)
    (if ss
      (repeat (setq i (sslength ss))
        (setq lst (cons (ssname ss (setq i (1- i))) lst))
      )
    )
  )

  ;; 角度排序函数(处理跨0度情况)
  (defun sort-angles (lst)
    (vl-sort lst
      '(lambda (a b)
        (< (car a) (car b))
      )
    )
  )

  ;; 主程序
  (if (setq ss (ssget '((0 . "LINE,ARC,CIRCLE"))))
    (progn
      (foreach ent (get-entities ss)
        (process-ent ent)
      )
      (princ "\n恢复操作已完成!")
    )
    (princ "\n未选择任何对象")
  )
  (princ)
)
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-4-5 02:42 , Processed in 0.155902 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表