圆弧改圆，删除重复圆

zhufeng1004

(defun c:TT (/ ss i ent entData center radius existingCircles isDuplicate)
  ;; 提示用户选择圆弧
  (prompt "\n选择要转换为圆的圆弧: ")
  (setq ss (ssget '((0 . "ARC")))) ;; 只选择圆弧对象

  ;; 检查是否有选中的对象
  (if ss
    (progn
      ;; 初始化一个列表，用于存储已创建的圆的圆心和半径
      (setq existingCircles '())

      ;; 遍历选中的每一个圆弧
      (setq i 0)
      (while (< i (sslength ss))
        (setq ent (ssname ss i)) ;; 获取当前圆弧的图元名
        (setq entData (entget ent)) ;; 获取圆弧的图元数据
        (setq center (cdr (assoc 10 entData))) ;; 获取圆弧的中心点
        (setq radius (cdr (assoc 40 entData))) ;; 获取圆弧的半径

        ;; 检查是否已经存在相同的圆
        (setq isDuplicate nil)
        (foreach circle existingCircles
          (if (and (equal center (car circle) 1e-6) ;; 比较圆心
                   (equal radius (cadr circle) 1e-6)) ;; 比较半径
            (setq isDuplicate t)
          )
        )

        ;; 如果没有重复，则创建新的圆并记录
        (if (not isDuplicate)
          (progn
            (entmake
              (list
                '(0 . "CIRCLE") ;; 图元类型为圆
                (cons 10 center) ;; 圆心
                (cons 40 radius) ;; 半径
              )
            )
            ;; 将新圆的圆心和半径添加到列表中
            (setq existingCircles (cons (list center radius) existingCircles))
          )
        )

        ;; 删除旧的圆弧
        (entdel ent)

        ;; 移动到下一个圆弧
        (setq i (1+ i))
      )
      (prompt "\n已完成圆弧到圆的转换，并删除了重复的圆。")
    )
    (prompt "\n未选择任何圆弧。")
  )
  (princ) ;; 静默退出
)

GEGEYANG88

好！！！！

oistre

不能运行不能运行

GEGEYANG88

(setq ss (ssget '((0 . "CIRCLE,ARC")))) ;; 选择圆和圆弧对象
;;这样就爽了

完整武器

2024用了没有问题

xyp1964

1. (defun c:tt ()
   
2.   "圆弧改圆并删除重复圆"
   
3.   (prompt "\n选择要转换为圆的圆弧: ")
   
4.   (if (setq ss (ssget '((0 . "ARC"))))
   
5.     (progn
   
6.       (setq lst '()
   
7.             i   0
   
8.       )
   
9.       (while (< i (sslength ss))
   
10.         (setq en (entget (ssname ss i))
    
11.               p0 (cdr (assoc 10 en))
    
12.               rr (cdr (assoc 40 en))
    
13.         )
    
14.         (if (not (member (setq a (list p0 rr)) lst))
    
15.           (setq c1  (entmake (list '(0 . "CIRCLE") (cons 10 p0) (cons 40 rr)))
    
16.                 lst (cons a lst)
    
17.           )
    
18.         )
    
19.         (setq i (1+ i))
    
20.       )
    
21.       (command "erase" ss "")
    
22.     )
    
23.   )
    
24.   (princ)
    
25. )

(defun c:tt ()<br />   "圆弧改圆并删除重复圆"<br />   (prompt "\n选择要转换为圆的圆弧: ")<br />   (if (setq ss (ssget '((0 . "ARC"))))<br />     (progn<br />       (setq lst '()<br />             i   0<br />       )<br />       (while (< i (sslength ss))<br />         (setq en (entget (ssname ss i))<br />               p0 (cdr (assoc 10 en))<br />               rr (cdr (assoc 40 en))<br />         )<br />         (if (not (member (setq a (list p0 rr)) lst))<br />           (setq c1  (entmake (list '(0 . "CIRCLE") (cons 10 p0) (cons 40 rr)))<br />                 lst (cons a lst)<br />           )<br />         )<br />         (setq i (1+ i))<br />       )<br />       (command "erase" ss "")<br />     )<br />   )<br />   (princ)<br /> )

GEGEYANG88

(setq ss (ssget '((0 . "CIRCLE,ARC")))) ;; 选择圆和圆弧对象
;;这样就爽了

GEGEYANG88

(setq ss (ssget '((0 . "CIRCLE,ARC")))) ;; 选择圆和圆弧对象，可以严格保证”圆弧改圆，删除重复圆“逻辑