求大神改下这个查字画圆，改为查相同图块画圆

664571221

求大神改下这个查字画圆，改为查相同图块画圆

ssyfeng

增加了图层和线宽：

ssyfeng

识别相同块名：

嘒彼小星

664571221 发表于 2023-7-28 20:47
大哥能不能放入放入     你好123   这个图层，如果没有就新建这个图层，还有能不能把圆的线变粗线

在院长的代码基础上，子程序后，if前。加代码，
(setq layer_tc (tblsearch "layer" "你好123"))
(if (= layer_tc nil)(command "-LAYER" "n" "你好123" ""))
(command "LAYER" "S" "你好123" "")
然后循环里面的圆的命令改为
(command "PLINE" "non" p1 "w" "5" "5" "A" "A" "180" "non" p2 "CL")
上面这两个5 根据你需要的线的粗细来更改为别的数值。

完整的就像下面这样：

1. (defun c:iy ()
   
2.   (defun mimx (s1 / p1 p9)
   
3.     (vla-getboundingbox (vlax-ename->vla-object s1) 'p1 'p9)
   
4.     (list (vlax-safearray->list p1) (vlax-safearray->list p9))
   
5.   )
   
6.   (setq layer_tc (tblsearch "layer" "你好123"))
   
7.   (if (= layer_tc nil)(command "-LAYER" "n" "你好123" ""))
   
8. (command "LAYER" "S" "你好123" "")
   
9.   (if (and (setq s1 (car (entsel "\n选择图块: ")))
   
10.            (= (cdr (assoc 0 (entget s1))) "INSERT")
    
11.            (setq bk (cdr (assoc 2 (entget s1))))
    
12.            (setq ss (ssget "x" (list (cons 2 bk))))
    
13.       )
    
14.     (progn
    
15.       (setq i -1)
    
16.       (while (setq s1 (ssname ss (setq i (1+ i))))
    
17.         (setq ptn (mimx s1)
    
18.               p1  (car ptn)
    
19.               p2  (cadr ptn)
    
20.         )
    
21.         (command "PLINE" "non" p1 "w" "5" "5" "A" "A" "180" "non" p2 "CL")
    
22.       )
    
23.     )
    
24.   )
    
25.   (princ)
    
26. )

(defun c:iy ()<br />   (defun mimx (s1 / p1 p9)<br />     (vla-getboundingbox (vlax-ename->vla-object s1) 'p1 'p9)<br />     (list (vlax-safearray->list p1) (vlax-safearray->list p9))<br />   )<br />   (setq layer_tc (tblsearch "layer" "你好123"))<br />   (if (= layer_tc nil)(command "-LAYER" "n" "你好123" ""))<br /> (command "LAYER" "S" "你好123" "")<br />   (if (and (setq s1 (car (entsel "\n选择图块: ")))<br />            (= (cdr (assoc 0 (entget s1))) "INSERT")<br />            (setq bk (cdr (assoc 2 (entget s1))))<br />            (setq ss (ssget "x" (list (cons 2 bk))))<br />       )<br />     (progn<br />       (setq i -1)<br />       (while (setq s1 (ssname ss (setq i (1+ i))))<br />         (setq ptn (mimx s1)<br />               p1  (car ptn)<br />               p2  (cadr ptn)<br />         )<br />         (command "PLINE" "non" p1 "w" "5" "5" "A" "A" "180" "non" p2 "CL")<br />       )<br />     )<br />   )<br />   (princ)<br /> )

ssyfeng

查块名相同、比例相同、旋转角度都相同？

664571221

ssyfeng 发表于 2023-7-28 16:54
查块名相同、比例相同、旋转角度都相同？

不用考虑角度，只要名称一样

xyp1964

1. (defun c:tt ()
   
2.   (defun mimx (s1 / p1 p9)
   
3.     (vla-getboundingbox (vlax-ename->vla-object s1) 'p1 'p9)
   
4.     (list (vlax-safearray->list p1) (vlax-safearray->list p9))
   
5.   )
   
6.   (if (and (setq s1 (car (entsel "\n选择图块: ")))
   
7.            (= (cdr (assoc 0 (entget s1))) "INSERT")
   
8.            (setq bk (cdr (assoc 2 (entget s1))))
   
9.            (setq ss (ssget "x" (list (cons 2 bk))))
   
10.       )
    
11.     (progn
    
12.       (setq i -1)
    
13.       (while (setq s1 (ssname ss (setq i (1+ i))))
    
14.         (setq ptn (mimx s1)
    
15.               p1  (car ptn)
    
16.               p2  (cadr ptn)
    
17.         )
    
18.         (command "circle" "2p" "non" p1 "non" p2)
    
19.       )
    
20.     )
    
21.   )
    
22.   (princ)
    
23. )

(defun c:tt ()<br />   (defun mimx (s1 / p1 p9)<br />     (vla-getboundingbox (vlax-ename->vla-object s1) 'p1 'p9)<br />     (list (vlax-safearray->list p1) (vlax-safearray->list p9))<br />   )<br />   (if (and (setq s1 (car (entsel "\n选择图块: ")))<br />            (= (cdr (assoc 0 (entget s1))) "INSERT")<br />            (setq bk (cdr (assoc 2 (entget s1))))<br />            (setq ss (ssget "x" (list (cons 2 bk))))<br />       )<br />     (progn<br />       (setq i -1)<br />       (while (setq s1 (ssname ss (setq i (1+ i))))<br />         (setq ptn (mimx s1)<br />               p1  (car ptn)<br />               p2  (cadr ptn)<br />         )<br />         (command "circle" "2p" "non" p1 "non" p2)<br />       )<br />     )<br />   )<br />   (princ)<br /> )

mokson

非常实用，感谢楼主的分享！

664571221

mokson 发表于 2023-7-28 19:22
非常实用，感谢楼主的分享！

兄弟你的编程学的怎么样了

664571221

ssyfeng 发表于 2023-7-28 17:25
识别相同块名：

谢谢兄弟...........

664571221

xyp1964 发表于 2023-7-28 18:59

谢谢派大........

664571221

ssyfeng 发表于 2023-7-28 17:25
识别相同块名：

大哥能不能放入放入     你好123   这个图层，如果没有就新建这个图层，还有能不能把圆的线变粗线