从DCL bu运行函数
*免责声明*我不确定这段代码来自哪里，它可能是从几个论坛帖子中散列出来的。我正在修改这个层重命名器，但效果不太好。我已经设置好了对话框，工作正常。我有层重命名功能设置和工作良好。问题是，当我试图从对话框中执行层重命名功能时，它崩溃了。
我认为它陷入了一个循环中，因为VLIDE被卡住了，直到我关闭AutoCAD绘图并打开一个新的。为了简洁起见，我简化了代码。如果有人能看一下并提出一些建议，我将不胜感激。提前感谢！
;|------BEGIN---LAYER RENAMER DIALOG BOX---------------------------------------------------------------|;
(defun C:layerRenamer (/ dcl_id fn fname)
(vl-load-com)
(create_dialog)
(setq dcl_id (load_dialog fname))
(if (not (new_dialog "layerRenamer" dcl_id))
(exit)
) ;if
(action_tile ;This action tile causes a crash when using the UnitLayer function.It works fine when using the testFunction.
"btnUnit"
"(c:unitLayer)"
)
(start_dialog)
(unload_dialog dcl_id)
(vl-file-delete fname)
(princ)
)
(defun create_dialog ()
(setq fname (vl-filename-mktemp "dcl.dcl"))
(setq fn (open fname "w"))
(write-line
"layerRenamer : dialog {
label = \"Automated Layer Renaming - V06-08-15\";
: column {
: boxed_column {
: button {
key = \"btnUnit\";
label = \"Fix Standard Unit Layers\";
is_default = false;
}
}
: boxed_row {
: button {
key = \"cancel\";
label = \"Close\";
is_default = true;
is_cancel = true;
}
}
}
}"fn
)
(close fn)
)
;|------END-----LAYER RENAMER DIALOG BOX---------------------------------------------------------------|;
;|------BEGIN---BASIC RENAMING FUNCTION----------------------------------------------------------------|;
(defun c:renameLayer ( oldLayer newLayer / ss i ent )
(cond ((and (tblsearch "layer" oldLayer) (not (tblsearch "layer" newLayer)))
(command "._rename" "la" oldLayer newLayer)
)
((and (tblsearch "layer" oldLayer)(tblsearch "layer" newLayer))
(setq ss (ssget "x" (list (cons 8 oldLayer))))
(setq i -1)
(repeat (sslength ss)
(setq ent (entget (ssname ss (setq i (1+ i))))
ent (subst (cons 8 newLayer) (cons 8 (cdr (assoc 8 ent))) ent)
)
(entmod ent)
)
)
((not (tblsearch "layer" oldLayer))
(prompt (strcat "\nLayer " oldLayer " not found. "))
)
)
(princ)
)
;|------END-----BASIC RENAMING FUNCTION----------------------------------------------------------------|;
;|------BEGIN---DRAWING SPECIFIC RENAMING FUNCTIONS----------------------------------------------------|;
(defun c:unitLayer ( / newLayer ) ;This function runs perfectly when run from the command line but crashes when run from dialog box.
(setq newLayer "1_ANSI")
(foreach oldLayer '("ANSI" "_ANSI" "F.H." "1_F.H.") (renameLayer oldLayer newLayer))
(command "._purge" "la" "" "n")
)
;|------END-----DRAWING SPECIFIC RENAMING FUNCTIONS----------------------------------------------------|;
(defun c:testFunction ()
(print "Test Function Ran")
(princ)
)
从程序c:Rename层中删除c:Rename层，然后重试。 删除renameLayer函数中的c:后，仍然会出现相同的错误。谢谢你捕捉到了这一点，我没有注意到它仍然被设置为一个命令函数。 当DCL对话框处于活动状态时，不能调用（命令）函数。 试试这个快速修改。
(defun c:Test (/ *error* echo dc fn fname prg)
(defun *error* (msg)
(if (and fname (findfile fname))
(vl-file-delete fname)
)
(if echo
(setvar 'CMDECHO echo)
)
(if (and msg
(not (wcmatch (strcase msg) "*CANCEL*,*BREAK*,*EXIT*"))
)
(princ (strcat "\nError =>: " msg "..."))
)
(princ)
)
(if
(and
(setq fname (vl-filename-mktemp "dcl.dcl"))
(setq fn (open fname "w"))
(write-line
"tmp : dialog { label = \"Automated Layer Renaming - V06-08-15\";
: column {
: boxed_column { : button { key = \"btnUnit\"; label = \"Fix Standard Unit Layers\"; is_default = false;}}
: boxed_row { : button { key = \"cancel\"; label = \"Close\"; is_default = true; is_cancel = true;}}}}"
fn
)
(not (close fn))
)
(progn
(if (and (<= 0 (setq dc (load_dialog fname)))
(new_dialog "tmp" dc)
)
(progn (action_tile
"btnUnit"
"(unitLayer)(setq prg t)(done_dialog)"
)
(start_dialog)
(unload_dialog dc)
(vl-file-delete fname)
(if prg
(progn
(setq echo (getvar 'CMDECHO))
(setvar 'CMDECHO 0)
(command "._-purge" "la" "" "n")
(setvar 'CMDECHO echo)
)
)
)
(progn (if (>= dc 0)
(unload_dialog dc)
)
(if (and fname (setq fname (findfile fname)))
(vl-file-delete fname)
)
)
)
)
)
(princ)
)
(defun unitLayer (/ layers newLayer ss i ent)
(setq layers (vla-get-layers
(vla-get-activedocument (vlax-get-acad-object))
)
newLayer "1_ANSI"
)
(foreach oldLayer '("ANSI" "_ANSI" "F.H." "1_F.H.")
(cond ((and (tblsearch "layer" oldLayer)
(not (tblsearch "layer" newLayer))
)
(vla-put-name (vla-item layers oldLayer) newLayer)
)
((and (tblsearch "layer" oldLayer)
(tblsearch "layer" newLayer)
(setq ss (ssget "_X" (list (cons 8 oldLayer))))
)
(repeat (setq i (sslength ss))
(setq ent (entget (ssname ss (setq i (1- i))))
ent (subst (cons 8 newLayer)
(assoc 8 ent)
ent
)
)
(entmod ent)
)
)
((not (tblsearch "layer" oldLayer))
(prompt (strcat "\nLayer " oldLayer " not found. "))
)
)
)
(princ)
)(vl-load-com)
我不确定如何在renameLayer函数中重命名层。
;(command "._purge" "la" "" "n")
我可以在unitLayer函数开始之前卸载对话框，以便使用命令吗？
如果在卸载对话框之前必须运行该函数，那么我可能需要从使用命令行切换到使用Visual Lisp重命名层。我在AfraLISP上找到了关于使用VLISP和层的完整论述。 感谢您重新编写Tharwat。它运行得很好。我必须在这个脚本中增加7个分层标准（6个按钮），在每个标准中重命名大约20个层。有没有可能像以前一样将其分成两个函数？我想试着根据你的代码自己编写代码，只是想知道你是否预见到这样工作会有任何问题。 很高兴听到这个消息。非常欢迎你。
当然，你可以添加任意数量的代码，只要试着编写代码，如果你需要任何帮助，请尽管问，我会尽力帮助你（当然，如果可能的话）。
注意：我已经更新了我上次回复中的代码，并添加了一些额外代码的错误处理，以更准确。
祝你好运
塔瓦特 好的，我回来了，几乎一切都正常。我添加了一个功能来搜索dwg中的所有块，并更改任何非标准层的层，但我无法使其检查未插入模型空间的块。我已经在Autodesk论坛上修改了用户pbejse编写的代码。有什么建议吗？
(command "._rename" "la" oldLayer newLayer) （setq ss（ssget“x”（list（cons 0“insert”）（cons 410（getvar“ctab”））（cons 2“*TITLEBLOCK*”）））
将ctab替换为布局中的名称&“标题栏*”替换为块中的名称，以从图纸空间中的特定布局中选择块
gr.Rlx 谢谢rlx，但我在上一篇文章中不够具体。我希望它能够获得块表中的块，但不会插入到图形中的任何位置。也许我需要看一下对块进行表搜索，看看是否会返回所有块。我注意到它也不会改变嵌套块插入的层或嵌套块内的线层。
页:
[1]
2