是否有办法在一个文件的同名块中，快速描一条当前层或自定义层的PL多义线？（已解决）

chenry676

作者能再帮帮我妈？目前是提示找不到图层_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))))
                (setq  p1 (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

应该是这样吧
(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))))
                (setq  p1 (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))
)

chenry676

我这边显示参数类型错误。

自贡黄明儒

其实没有必要存在这个程序

chenry676

start4444 发表于 2020-12-28 19:06
应该是这样吧
(defun c:tt5 (/ bname en entname i p1 p2 ss);;;;;图框块加外框线
        (command "undo" "be" ...

前面加了您的代码，还是提示参数类型错误，能否帮我完整稍微整理一下？谢谢！

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))))
                (setq  p1 (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))
)

chenry676

start4444 发表于 2020-12-29 09:57
漏了i
(defun c:tt5 (/ bname en entname i p1 p2 ss)
        (vl-load-com)

非常感谢start4444，我正需要这种功能！

chenry676

能否帮我增加一个选择功能项，并为记忆模式，就是描出来的线自动为“_TITLE”层，且为1号红色线，因为这个基本是描图框用的，另一个选项就是目前的当前层。可以为记忆模式，上一次使用什么选项，这次就是默认什么选项，谢谢！

chenry676

start4444 发表于 2020-12-29 09:57
漏了i
(defun c:tt5 (/ bname en entname i p1 p2 ss)
        (vl-load-com)

能否帮我增加以上功能？谢谢！

chenry676

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层，也就是有该图层就自动归属到该图层，无该图层自动新建并归属到该图层，谢谢！