是否有办法在一个文件的同名块中，快速描一条当前层或自定义层的PL多义线？（已解决）
本帖最后由 chenry676 于 2021-12-30 10:44 编辑作者能再帮帮我妈？目前是提示找不到图层_TITLE。错误函数被取消，因为本文件原来没有_TITLE层，在没有_TITLE图层的情况下，能否自动新建一个_TITLE层，也就是有该图层就自动归属到该图层，无该图层自动新建并归属到该图层，十分感谢！
以下为作者start4444帮我写的代码：
增加图层切换健 q
(defun c:tt5 (/ bname en ent entname i p1 p2 ss tt)
(vl-load-com)
(command "undo" "be")
(setvar "cmdecho" 0)
(if (null key ) (setq key 1))
(setq tt t)
(while tt
(initget "Q")
(setq ent (entsel (strcat"\n选择图框<"(if (= key 1) "_TITLE" "当前层")">[切换(Q)]：")))
(if (= ent "Q") (setq key (if (= key 1) 2 1)) (setq tt nil)))
(setq entname (car ent) bname (cdr (assoc 2 (entget entname))) ss (ssget "X" (list '(0 . "INSERT") (cons 2 bname))) i -1)
(while (setq en (ssname ss (setq i (1+ i))))
(setqp1 (car (enbox en)) p2 (cadr (enbox en)))
(if (= key 1) (command "RECTANG" "non" p1 "non" p2"CHANGE" (entlast) "" "p" "c" 1"p" "la" "_TITLE" "") (command "RECTANG" "non" p1 "non" p2"CHANGE" (entlast) "" "p" "c" 1 ""))
)
(setvar "cmdecho" 1)
(command "undo" "e")
(princ)
)
(defun enbox (ename / ll ur)
(vla-getboundingbox (vlax-ename->vla-object ename) 'll 'ur)
(mapcar 'vlax-safearray->list (list ll ur))
)
应该是这样吧
(defun c:tt5 (/ bname en entname i p1 p2 ss);;;;;图框块加外框线
(command "undo" "be")
(setq entname (car (entsel "\n选择图框:")) bname (cdr (assoc 2 (entget entname))) ss (ssget "X" (list '(0 . "INSERT") (cons 2 bname))))
(while (setq en (ssname ss (setq i (1+ i))))
(setqp1 (car (enbox en)) p2 (cadr (enbox en)))
(command "RECTANG" "non" p1 "non" p2)
)
(command "undo" "e")
(princ)
)
(defun enbox (ename / ll ur)
(vla-getboundingbox (vlax-ename->vla-object ename) 'll 'ur)
(mapcar 'vlax-safearray->list (list ll ur))
) 我这边显示参数类型错误。 其实没有必要存在这个程序 start4444 发表于 2020-12-28 19:06
应该是这样吧
(defun c:tt5 (/ bname en entname i p1 p2 ss);;;;;图框块加外框线
(command "undo" "be" ...
前面加了您的代码，还是提示参数类型错误，能否帮我完整稍微整理一下？谢谢！ 本帖最后由 start4444 于 2021-1-5 16:59 编辑
增加图层切换健 q
(defun c:tt5 (/ bname en ent entname i p1 p2 ss tt)
(vl-load-com)
(command "undo" "be")
(setvar "cmdecho" 0)
(if (null key ) (setq key 1))
(setq tt t)
(while tt
(initget "Q")
(setq ent (entsel (strcat"\n选择图框<"(if (= key 1) "_TITLE" "当前层")">[切换(Q)]：")))
(if (= ent "Q") (setq key (if (= key 1) 2 1)) (setq tt nil)))
(setq entname (car ent) bname (cdr (assoc 2 (entget entname))) ss (ssget "X" (list '(0 . "INSERT") (cons 2 bname))) i -1)
(while (setq en (ssname ss (setq i (1+ i))))
(setqp1 (car (enbox en)) p2 (cadr (enbox en)))
(if (= key 1) (command "RECTANG" "non" p1 "non" p2"CHANGE" (entlast) "" "p" "c" 1"p" "la" "_TITLE" "") (command "RECTANG" "non" p1 "non" p2"CHANGE" (entlast) "" "p" "c" 1 ""))
)
(setvar "cmdecho" 1)
(command "undo" "e")
(princ)
)
(defun enbox (ename / ll ur)
(vla-getboundingbox (vlax-ename->vla-object ename) 'll 'ur)
(mapcar 'vlax-safearray->list (list ll ur))
)
start4444 发表于 2020-12-29 09:57
漏了i
(defun c:tt5 (/ bname en entname i p1 p2 ss)
(vl-load-com)
非常感谢start4444，我正需要这种功能！ 能否帮我增加一个选择功能项，并为记忆模式，就是描出来的线自动为“_TITLE”层，且为1号红色线，因为这个基本是描图框用的，另一个选项就是目前的当前层。可以为记忆模式，上一次使用什么选项，这次就是默认什么选项，谢谢！ start4444 发表于 2020-12-29 09:57
漏了i
(defun c:tt5 (/ bname en entname i p1 p2 ss)
(vl-load-com)
能否帮我增加以上功能？谢谢！ 本帖最后由 chenry676 于 2021-1-9 18:06 编辑
start4444 发表于 2020-12-29 09:57
增加图层切换健 q
(defun c:tt5 (/ bname en ent entname i p1 p2 ss tt)
(vl-load-com)
目前是提示找不到图层_TITLE。错误函数被取消，因为本文件原来没有_TITLE层，在没有_TITLE图层的情况下，能否自动新建一个_TITLE层，也就是有该图层就自动归属到该图层，无该图层自动新建并归属到该图层，谢谢！
页:
[1]