框选圆，不同直径插入不同名的块

戏男

如题，框选圆，不同直径插入不同名的块，块名要能自己修改

xj6019

(defun c:NM (/ i name names p r s1 ss)
  (setq i -1 names nil)
  (if(setq ss (ssget (list '(0 . "CIRCLE")(cons 8 "0"))))
    (while(and(setq s1 (ssname ss (setq i (1+ i)))))               
                        (setq r(cdr(assoc 40 (entget s1)))
                                p(cdr(assoc 10 (entget s1)))
                        )
                        (if (tblsearch "BLOCK" (setq name(strcat "epin_ejp_" (rtos(* 2 r)2 1))))                                
                                (progn
                                        (entmakeX
                                                (list '(0 . "INSERT")
                                                        '(100 . "AcDbEntity")
                                                        '(100 . "AcDbBlockReference")
                                                        (cons 2 name)
                                                        (cons 10 p)
                                                        (cons 50 0) ;弧度
                                                        (cons 41 1)
                                                        (cons 42 1)
                                                        (cons 43 1)
                                                )
                                        )                                       
                                )
                                (setq names(cons name names))
                        )               
                )
  )
        (if names
                (progn
                        (princ "\n对应直径当前文件内，缺失的块名有:")        
                        (princ names)
                )
                (princ "\n所有圆均插入对应图块成功！")
        )        
        (princ )
)

戏男

xj6019 发表于 2023-9-9 11:05
(defun c:NM (/ i name names p r s1 ss)
  (setq i -1 names nil)
  (if(setq ss (ssget (list '(0 . " ...

真历害，我以为需要改图块名，对了，如果自己想换图块名字呢？换了图块名字是不是就不行了呀？

戏男

xj6019 发表于 2023-9-9 11:05
(defun c:NM (/ i name names p r s1 ss)
  (setq i -1 names nil)
  (if(setq ss (ssget (list '(0 . " ...

换另一个图档就用不了呢？要能用图块名插入的呀，不是弧度相等，

xj6019

戏男 发表于 2023-9-9 15:14
换另一个图档就用不了呢？要能用图块名插入的呀，不是弧度相等，

对应改你这里块名的前缀就行

戏男

xj6019 发表于 2023-9-9 15:35
对应改你这里块名的前缀就行

新建一个图档就用不了啦，不信你弄一个新图档画几个不等径的圆试一下

戏男

xj6019 发表于 2023-9-9 15:35
对应改你这里块名的前缀就行

试下这个测试图，就不成功了，怎么回事呢？

xj6019

戏男 发表于 2023-9-9 19:25
试下这个测试图，就不成功了，怎么回事呢？

因为加了图层过滤，我本意是有图层过滤，不会选择到不该选择的圆，如果你觉得每次不会错误选择的话，可以把图层过滤删掉就行
这一句
(setq ss (ssget (list '(0 . "CIRCLE")(cons 8 "0"))))
改为下面，将8组码的图层删掉即可
(setq ss (ssget (list '(0 . "CIRCLE"))))

戏男

xj6019 发表于 2023-9-10 09:44
因为加了图层过滤，我本意是有图层过滤，不会选择到不该选择的圆，如果你觉得每次不会错误选择的话，可以 ...

改成这样了没效果，还是不行呀
(defun c:NM (/ i name names p r s1 ss)
  (setq i -1 names nil)
  (if(setq ss (ssget (list '(0 . "CIRCLE"))))
    (while(and(setq s1 (ssname ss (setq i (1+ i)))))               
                        (setq r(cdr(assoc 40 (entget s1)))
                                p(cdr(assoc 10 (entget s1)))
                        )
                        (if (tblsearch "BLOCK" (setq name(strcat "epin_ejp_" (rtos(* 2 r)2 1))))                                
                                (progn
                                        (entmakeX
                                                (list '(0 . "INSERT")
                                                        '(100 . "AcDbEntity")
                                                        '(100 . "AcDbBlockReference")
                                                        (cons 2 name)
                                                        (cons 10 p)
                                                        (cons 50 0) ;弧度
                                                        (cons 41 1)
                                                        (cons 42 1)
                                                        (cons 43 1)
                                                )
                                        )                                       
                                )
                                (setq names(cons name names))
                        )               
                )
  )
        (if names
                (progn
                        (princ "\n对应直径当前文件内，缺失的块名有:")        
                        (princ names)
                )
                (princ "\n所有圆均插入对应图块成功！")
        )        
        (princ )
)

xj6019

戏男 发表于 2023-9-10 13:58
改成这样了没效果，还是不行呀
(defun c:NM (/ i name names p r s1 ss)
  (setq i -1 names nil)

复制你贴的代码一个字都没改，完美运行，不知道你咋弄的