正如我提到的那样，我遇到了一个可能的解决方案，但必须重新开始。 irneb，
我已经试着整合你的代码，但我似乎无法让它工作。这就是我所拥有的。你能看一下吗？
(defun c:survey_transform ()
; First construct our entity list
(setq vl1 (list
(cons 0 "LAYER") ;Name of entity
(cons 100 "AcDbSymbolTableRecord") ;Open Records
(cons 100 "AcDbLayerTableRecord") ;Locate Layer Table
(cons 2 "CCC_SURVEY_EXISTING_Feature") ;Name of Layer
(cons 6 "Continuous") ;Linetype
(cons 62 150) ;colour = light grey
(cons 70 0) ;state
(cons 290 1) ;1=plot, 0=Don't plot
) ;End of entity list
)
(entmake vl1)
(setq vl1 (list
(cons 0 "LAYER") ;Name of entity
(cons 100 "AcDbSymbolTableRecord") ;Open Records
(cons 100 "AcDbLayerTableRecord") ;Locate Layer Table
(cons 2 "CCC_SURVEY_EXISTING_Number") ;Name of Layer
(cons 6 "Continuous") ;Linetype
(cons 62 1) ;colour = light grey
(cons 70 0) ;state
(cons 290 1) ;1=plot, 0=Don't plot
) ;End of entity list
)
(entmake vl1)
(setq vl1 (list
(cons 0 "LAYER") ;Name of entity
(cons 100 "AcDbSymbolTableRecord") ;Open Records
(cons 100 "AcDbLayerTableRecord") ;Locate Layer Table
(cons 2 "CCC_SURVEY_EXISTING_Level") ;Name of Layer
(cons 6 "Continuous") ;Linetype
(cons 62 84) ;colour = light grey
(cons 70 0) ;state
(cons 290 1) ;1=plot, 0=Don't plot
) ;End of entity list
)
(entmake vl1)
(setq vl1 (list
(cons 0 "LAYER") ;Name of entity
(cons 100 "AcDbSymbolTableRecord") ;Open Records
(cons 100 "AcDbLayerTableRecord") ;Locate Layer Table
(cons 2 "CCC_SURVEY_Level") ;Name of Layer
(cons 6 "Continuous") ;Linetype
(cons 62 84) ;colour = light grey
(cons 70 0) ;state
(cons 290 1) ;1=plot, 0=Don't plot
) ;End of entity list
)
(entmake vl1)
(setq vl1 (list
(cons 0 "LAYER") ;Name of entity
(cons 100 "AcDbSymbolTableRecord") ;Open Records
(cons 100 "AcDbLayerTableRecord") ;Locate Layer Table
(cons 2 "CCC_SURVEY_Number") ;Name of Layer
(cons 6 "Continuous") ;Linetype
(cons 62 1) ;colour = light grey
(cons 70 0) ;state
(cons 290 1) ;1=plot, 0=Don't plot
) ;End of entity list
)
(entmake vl1)
; First construct our entity list
(setq vl1 (list
(cons 0 "LAYER") ;Name of entity
(cons 100 "AcDbSymbolTableRecord") ;Open Records
(cons 100 "AcDbLayerTableRecord") ;Locate Layer Table
(cons 2 "CCC_SURVEY_Feature") ;Name of Layer
(cons 6 "Continuous") ;Linetype
(cons 62 150) ;colour = light grey
(cons 70 0) ;state
(cons 290 1) ;1=plot, 0=Don't plot
) ;End of entity list
)
(entmake vl1)
(and (setq ss (ssget "X" '((8 . "*CODE"))))
(command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Feature" ""))
(and (setq ss (ssget "X" '((8 . "*ID"))))
(command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Number" ""))
(and (setq ss (ssget "X" '((8 . "*_Z"))))
(command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Level" ""))
(and (setq ss (ssget "X" '((8 . "*Points"))))
(command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Level" ""))
(and (setq text1(ssget "x" (list '(0 . "TEXT") (cons 62 70))))
(command "_.CHPROP" TEXT1 "" "_LA" "CCC_SURVEY_Level" ""))
(and (setq text2(ssget "x" (list '(0 . "TEXT") (cons 62 12))))
(command "_.CHPROP" TEXT2 "" "_LA" "CCC_SURVEY_Number" ""))
(and (setq text3(ssget "x" (list '(0 . "TEXT") (cons 62 152))))
(command "_.CHPROP" TEXT3 "" "_LA" "CCC_SURVEY_Feature" ""))
(and (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 62 70))))
(command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_Level" ""))
(and (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 62 12))))
(command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_Number" ""))
(and (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 62 152))))
(command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_Feature" ""))
(command "_.CHPROP" "all" "" "C" "BYLAYER" "")
(command "_.-layer" "_C" "84" "CCC_SURVEY_Level" "_C" "150" "CCC_SURVEY_Feature" "" )
(ImportLayers "T:\\Drawing Tools\\AutoCad 2010_WARNING_Do Not Modify\\CCC_Survey.dwt" T T)
(command "_-purge" "a" "*" "N")
(princ)
)
;;; -------------------------------------------------------------------------------------
;;; Global var to hold last used source drawing
;;; -------------------------------------------------------------------------------------
(setq *ImportLayersFrom* "T:\\Drawing Tools\\AutoCad 2010_WARNING_Do Not Modify\\CCC_Survey.dwt")
;;; -------------------------------------------------------------------------------------
;;; Command to match the current drawing's layers to a specified DWG file
;;; -------------------------------------------------------------------------------------
(defun ImportLayers (/ ans fn update import)
;(setq *ImportLayersFrom* "T:\\Drawing Tools\\AutoCad 2010_WARNING_Do Not Modify\\CCC_Survey.dwt")
(if (not (setq fn *ImportLayersFrom*))
(setq fn (if (and (= (getvar "FILEDIA") 1) (= (logand (getvar "CMDACTIVE") 4) 0))
(getfiled "Select source drawing" (getvar "DWGPREFIX") "dwg" (+ 4 8 16))
(getstring "\nSource DWG path: ")
)
)
)
(if (setq fn (findfile fn))
(progn
(setq *ImportLayersFrom* fn)
(princ (strcat "\nLoading from Source: " fn))
(while (progn
(princ (strcat "\nExisting layers will"
(if update
""
" NOT"
)
" be Updated; Linetypes will"
(if import
""
" NOT"
)
" be Improted"
)
)
(initget "Source Update Import Run Cancel")
(and (setq ans (getkword "\n <Run>: "))
(not (wcmatch ans "Run,Cancel"))
)
)
(cond
((eq ans "Update") (setq update (not update)))
((eq ans "Import") (setq import (not import)))
((and (eq ans "Source")
(setq fn (if (and (= (getvar "FILEDIA") 1) (= (logand (getvar "CMDACTIVE") 4) 0))
(getfiled "Select source drawing" (vl-filename-directory fn) "dwg" (+ 4 8 16))
(getstring "\nSource DWG path: ")
)
)
)
(if (setq fn (findfile fn))
(setq *ImportLayersFrom* fn)
(progn
(print (strcat fn " could not be found."))
(setq fn *ImportLayersFrom*)
)
)
)
)
)
(if (not (eq ans "Cancel"))
(ImportLayers fn update import)
)
)
)
(princ)
)
;;; -------------------------------------------------------------------------------------
;;; Function to match the current drawing's layers to a specified DWG file
;;; -------------------------------------------------------------------------------------
;;; Arguments:
;;; fn : File name (incl. path) of source DWG
;;; update : T to change existing layer to match, else nil
;;; ltypes : T to import linetypes if not existing, else nil
;;; -------------------------------------------------------------------------------------
;;; Result : T if done, nil if failed
;;; -------------------------------------------------------------------------------------
(defun ImportLayers (fn update ltypes / dbx1 complete dbxLayers dbxLay Lay val)
(setq complete nil)
(if (setq dbx (vla-GetInterfaceObject
(vlax-get-acad-object)
(strcat "ObjectDBX.AxDbDocument." (itoa (atoi (getvar "ACADVER"))))
)
)
(progn
(if (not
(vl-catch-all-error-p (vl-catch-all-apply 'vlax-invoke (list dbx 'open fn)))
)
(progn
;; Ensure all vla objects for current dwg
(or *acad* (setq *acad* (vlax-get-acad-object)))
(or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
(or *layers* (setq *layers* (vla-get-Layers *doc*)))
(or *linetypes* (setq *linetypes* (vla-get-LineTypes *doc*)))
;; Step through all layers of source dwg
(setq dbxLayers (vla-get-Layers dbx))
(vlax-for dbxLay dbxLayers
(if (vl-catch-all-error-p
(setq Lay (vl-catch-all-apply 'vla-Item (list *layers* (vla-get-Name dbxLay))))
)
(setq Lay (vla-Add *layers* (vla-get-Name dbxLay))) ;Create if not existing
(if (not update)
(setq Lay nil)
) ;Only continue if updating layers as well
)
(if Lay
(progn
;; Match description
(if (not
(vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-Description (list dbxLay))))
)
(vla-put-Description Lay val)
)
;; Match Plottable
(if (not
(vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-Plottable (list dbxLay))))
)
(vla-put-Plottable Lay val)
)
;; Match ViewportDefault
(if (not
(vl-catch-all-error-p
(setq val (vl-catch-all-apply 'vla-get-ViewportDefault (list dbxLay)))
)
)
(vla-put-ViewportDefault Lay val)
)
;; Match LineWeight
(if (not
(vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-LineWeight (list dbxLay))))
)
(vla-put-LineWeight Lay val)
)
;; Match colour
(if (not
(vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-TrueColor (list dbxLay))))
)
(vla-put-TrueColor Lay val)
)
;; Match linetype
(if (not
(vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-LineType (list dbxLay))))
)
(if (or (tblsearch "LTYPE" val)
(and ltypes ;Load linetype if not existing
(not (vl-catch-all-error-p
(vl-catch-all-apply
'vla-Load
(list *linetypes*
val
(if (= (getvar "MEASUREMENT") 0)
"acad.lin"
"acadiso.lin"
)
)
)
)
)
)
)
(vla-put-LineType Lay val)
)
)
)
)
)
(setq complete T)
)
)
(vlax-release-object dbx)
)
)
complete
) 我最初的代码是一个命令，而不是一个lisp可调用函数。因此，您不需要将原来的c:ImportLayersFrom重命名为ImportLayersFrom，请看最后，defun已经存在了。虽然这不会引起问题，因为最后一个应该在第一个加载。
你能说明你收到了什么错误信息吗？这个消息什么时候出现？加载lisp或运行survey\u transform命令时？你试过在VLIDE中调试吗？我通常会一步一步地检查lisp中的每一行，看看它在做什么，这是我在试图通过打开break-on-error来找到错误位置后做的第二件事。 这是我在将代码切换回c:ImportLayersFrom时遇到的错误
Command: survey_transform
Initializing...
Initializing...
Initializing...
Initializing...
Initializing...
Initializing...
Initializing...
Initializing...
Initializing...
Initializing...
Initializing...
Initializing...
它一直在继续！！！！ 你在执行自动加载吗？“初始化…”信息来自这类事情。如果只加载LSP文件，会发生什么？通过（load“Path/LispfileName.LSP”）或使用AppLoad，或者最好通过VLIDE。我的代码中没有任何地方显示“正在初始化…”。
我刚刚试着把它装在我的VLIDE上：
Lisp控制台中的消息是：
然后在ACad的命令行中输入命令：7尽管它失败了，因为我在该路径中没有DWT。
顺便说一句，您根本不需要在代码中使用c:ImportLayers-defun，您可以完全取消它。您只使用了最后一个ImportLayers defun。 这听起来很像。 这就是我现在拥有的。在阅读了LeeMac的链接后，我将子函数名更改为ImportLayers01，并认为这可以解决问题。当我打开一个绘图并尝试从ribbon运行lisp时，我得到了初始化。。。错误，但如果我执行appload，然后运行它，效果很好。有什么想法吗？
8 如果使用功能区，则会出现初始化错误。功能区中的宏是否只是发出survey\u transform命令？一、 e.你已经在某个自动加载的地方设置了它（ACADDOC.LSP/Menu.MNL/etc）？如果是这样，那么李指出的联系就是出了什么问题。如果您无法修复它，那么还有其他一些可行的选择：
将普通（加载“LispfileNameAndPath”）添加到ACADDOC。LSP或菜单。MNL；或
将此类代码添加到按钮的宏中；或
将LSP文件添加到您的启动套件中；或
那个自动加载的东西有一些问题，例如，你不能在一个普通的lisp函数上自动加载（只有lisp命令）。如果LSP文件中有错误或者你的设置中有其他错误，它会无限循环这个初始化错误。由于这些原因，我实际上为自己重新编写了autoload，但这已经超出了本文的主题。
页:
1
[2]