求大神改下这个查字画圆，改为查相同图块画圆
求大神改下这个查字画圆，改为查相同图块画圆增加了图层和线宽：
本帖最后由 ssyfeng 于 2023-7-28 17:48 编辑
识别相同块名：
本帖最后由 嘒彼小星 于 2023-7-29 10:07 编辑
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 根据你需要的线的粗细来更改为别的数值。
完整的就像下面这样：
(defun c:iy ()
(defun mimx (s1 / p1 p9)
(vla-getboundingbox (vlax-ename->vla-object s1) 'p1 'p9)
(list (vlax-safearray->list p1) (vlax-safearray->list p9))
)
(setq layer_tc (tblsearch "layer" "你好123"))
(if (= layer_tc nil)(command "-LAYER" "n" "你好123" ""))
(command "LAYER" "S" "你好123" "")
(if (and (setq s1 (car (entsel "\n选择图块: ")))
(= (cdr (assoc 0 (entget s1))) "INSERT")
(setq bk (cdr (assoc 2 (entget s1))))
(setq ss (ssget "x" (list (cons 2 bk))))
)
(progn
(setq i -1)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq ptn (mimx s1)
p1(car ptn)
p2(cadr ptn)
)
(command "PLINE" "non" p1 "w" "5" "5" "A" "A" "180" "non" p2 "CL")
)
)
)
(princ)
)
查块名相同、比例相同、旋转角度都相同？ ssyfeng 发表于 2023-7-28 16:54
查块名相同、比例相同、旋转角度都相同？
不用考虑角度，只要名称一样 (defun c:tt ()
(defun mimx (s1 / p1 p9)
(vla-getboundingbox (vlax-ename->vla-object s1) 'p1 'p9)
(list (vlax-safearray->list p1) (vlax-safearray->list p9))
)
(if (and (setq s1 (car (entsel "\n选择图块: ")))
(= (cdr (assoc 0 (entget s1))) "INSERT")
(setq bk (cdr (assoc 2 (entget s1))))
(setq ss (ssget "x" (list (cons 2 bk))))
)
(progn
(setq i -1)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq ptn (mimx s1)
p1(car ptn)
p2(cadr ptn)
)
(command "circle" "2p" "non" p1 "non" p2)
)
)
)
(princ)
) 非常实用，感谢楼主的分享！
mokson 发表于 2023-7-28 19:22
非常实用，感谢楼主的分享！
兄弟你的编程学的怎么样了 ssyfeng 发表于 2023-7-28 17:25
识别相同块名：
谢谢兄弟........... xyp1964 发表于 2023-7-28 18:59
谢谢派大........ ssyfeng 发表于 2023-7-28 17:25
识别相同块名：
大哥能不能放入放入 你好123 这个图层，如果没有就新建这个图层，还有能不能把圆的线变粗线