重定向Lisp例程

benfleck · 发表于 2022-7-5 16:29:05

我正在尝试编写一个lisp，它可以在保存时将图形中的所有外部参照设置为相对。我创建了一个save reactor，但无法使lisp例程工作。

保存反应堆：


(defun AtSaveCommand (calling-reactor b)
(if
 (or
 (= (car b) "QSAVE")
 (= (car b) "SAVEAS")
 (= (car b) "SAVE")
 )
(xrefpath)
)
)
(defun loadTheSaveReactor ()
(vl-load-com)
(if *FileOnSave* (vlr-remove *FileOnSave*))
(setq *FileOnSave*
(vlr-command-reactor nil '((:vlr-commandwillStart . AtSaveCommand)))
)
)
(loadTheSaveReactor)

Lisp例程

copy


(defun xrefpath ()
(COMMAND "redir" "*" "")
)

Lee Mac · 发表于 2022-7-5 16:36:45

你不能在反应堆中使用“命令”功能。。。

benfleck · 发表于 2022-7-5 16:51:18

GRRRRRR！！！

这不是我想要的答案，但这是休息！

Lee Mac · 发表于 2022-7-5 16:55:29

我知道你的意思。。。很烦人。

Lee Mac · 发表于 2022-7-5 17:05:36

引自AfraLISP：

3dwannab · 发表于 2022-7-5 17:07:35

试试这个：

此处的参考点：https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2016/ENU/AutoCAD-ActiveX/files/GUID-E13A580D-04CA-46C1-B807-95BB461A0A57-htm.html

copy

;; AtSaveCommand
;; loadTheSaveReactor
;; Found here: http://forums.augi.com/showthread.php?93534-Run-lisp-when-closing-drawing&p=926895&viewfull=1#post926895
(defun AtSaveCommand (calling-reactor b)
(if
        (or
                (= (car b) "QSAVE")
                (= (car b) "SAVEAS")
                (= (car b) "SAVE")
                )
        (progn
                (setq acadObj (vlax-get-acad-object))
                (setq activeDoc (vla-get-ActiveDocument acadObj))
                ;; Get activeDoc Help: https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2015/ENU/AutoCAD-ActiveX/files/GUID-161FD7E5-B739-4E09-8430-BA04A6298703-htm.html
                (if        (= (vla-get-ActiveSpace activeDoc) 1)
                        (progn
                                (vla-SendCommand activeDoc (strcat "._TEXTTOFRONT A "))
                                ; (vla-Regen activeDoc acAllViewports)
                                ; (vla-SendCommand activeDoc (strcat "_REGEN "))
                                )
                        (progn
                                ; (princ "\nSwitching to ModelSpace & Back, 1 sec...")(princ)
                                ;; (run your command here)
                                ;; Code changed from here
                                ;; YOu can run a command like so: See help here:
                                ;; https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2016/ENU/AutoCAD-ActiveX/files/GUID-E13A580D-04CA-46C1-B807-95BB461A0A57-htm.html
                                (vla-SendCommand activeDoc (strcat "._TILEMODE 1 "))
                                (vla-SendCommand activeDoc (strcat "._TEXTTOFRONT A "))
                                (vla-SendCommand activeDoc (strcat "._TILEMODE 0 "))
                                ; (vla-SendCommand activeDoc (strcat "_REGEN "))
                                ; (vla-Regen activeDoc acAllViewports)
                                )
                        )
                )
        )
)
(defun loadTheSaveReactor ()
(if *FileOnSave* (vlr-remove *FileOnSave*))
(setq *FileOnSave*
        (vlr-command-reactor nil '((:vlr-commandwillStart . AtSaveCommand)))
        )
)
(vl-load-com)
(loadTheSaveReactor)

Grrr · 发表于 2022-7-5 17:16:53

3dwannab，
将：VLR DWG Reactor与：VLR beginSave事件一起使用，也可以在回调函数外部全球化acDoc变量，或者在回调函数内部将其本地化。
还有那条帖子是2009年的，你为什么回复？

3dwannab · 发表于 2022-7-5 17:26:51

我只是想帮助其他人，因为线程是关于通过反应堆运行命令的。

谢谢你的指点。它正在正常工作。有时，旧代码只运行一次。（可能是因为我没有定位VAR。

copy


(defun BeginSave (objReactor lstDataBaseAndName / acadObj activeDoc cmd)
(setq cmd (getvar "cmdecho"))
(setvar 'cmdecho 0)
(setq acadObj (vlax-get-acad-object))
(setq activeDoc (vla-get-ActiveDocument acadObj))
(if        (= (vla-get-ActiveSpace activeDoc) 1)
        (progn
                (vla-SendCommand activeDoc (strcat "._TEXTTOFRONT A "))
                (vla-Regen activeDoc acAllViewports)
                )
        (progn
                (princ "\nSwitching to ModelSpace & Back, 1 sec...\n")(princ)
                (vla-SendCommand activeDoc (strcat "._TILEMODE 1 "))
                (vla-SendCommand activeDoc (strcat "._TEXTTOFRONT A "))
                (vla-SendCommand activeDoc (strcat "._TILEMODE 0 "))
                (vla-Regen activeDoc acAllViewports)
                )
        )
(setvar 'cmdecho cmd)
)
(if (not rxnBeginSave)
(setq rxnBeginSave (VLR-DWG-Reactor nil '((:VLR-beginSave . BeginSave ))))
)
(princ "\nDrawOrder_Reactor.lsp Loaded..")(princ)

3dwannab · 发表于 2022-7-5 17:35:28

放弃最后一个代码：

当您复制对象时，它的行为很糟糕，就像ACAD触发保存一样。因此，VLR DWG反应堆和：VLR beginSave将不起作用。

相反，最好使用vlr命令reactor，并且：vlr命令将开始监视命令行，以获取要触发事件的命令，例如：

copy

        (if (wcmatch (strcase (car arg)) "SAVE,QSAVE,SAVEAS,PLOT")
        (setdraworder)
        )

这里有两种不同的工作解决方案，第一种是命令行TEXTTOFRONT。注意：最好在整个程序中使用vla SendCommand，否则ACAD似乎会陷入一个糟糕的循环。

第二个是LeeMacs reactor的修改版本，用于处理此处的文本和模糊对象。我用它运行，因为它不需要额外的保存来保持Draworder。（我认为（vla SendCommand）的另一个缺点）。

我的命令使用TEXTTOFRONT调用DrawOrder Reactor

copy

;; setdraworder
;; loadTheSaveReactor
;; Found here: http://forums.augi.com/showthread.php?93534-Run-lisp-when-closing-drawing&p=926895&viewfull=1#post926895
;;
;; You can run a command like so: See help here:
;; https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2016/ENU/AutoCAD-ActiveX/files/GUID-E13A580D-04CA-46C1-B807-95BB461A0A57-htm.html
;;
;; by 3dwannab to work with all HATCH, TEXT, LEADER and DIM objects
;;
;; Known Bugs: Needs additional Save to Save DRAWORDER of Objects
(defun setdraworder ( /
acadObj
doc
activeSpe
)
(setq acadObj (vlax-get-acad-object))
(setq doc (vla-get-ActiveDocument acadObj))
(setq activeSpe (vla-get-ActiveSpace doc))
(if        (= 1 activeSpe)
(progn
        (vla-SendCommand doc (strcat "._TEXTTOFRONT A "))
        (vla-SendCommand doc (strcat "._HATCHTOBACK "))
        )
(progn
        (princ "\nSwitching to ModelSpace & Back, 1 sec...")(princ)
        (vla-SendCommand doc (strcat "._TILEMODE 1 "))
        (vla-SendCommand doc (strcat "._TEXTTOFRONT A "))
        (vla-SendCommand doc (strcat "._HATCHTOBACK "))
        (vla-SendCommand doc (strcat "._TILEMODE 0 "))
        )
)
(vla-Regen doc acActiveViewport)
(princ "\n >>> Draworder Reactor is Running ...\n")(princ)
)
(defun draworder:callback ( obj arg )
(if (wcmatch (strcase (car arg)) "SAVE,QSAVE,SAVEAS,PLOT")
        (setdraworder)
        )
(princ)
)
(defun loadTheSaveReactor ()
(vl-load-com)
(if (null draworder:reactor)
        (setq draworder:reactor (vlr-command-reactor nil '((:vlr-commandwillstart . draworder:callback))))
        )
(princ)
)
(loadTheSaveReactor)

LeeMac模块：
编辑后，用户可以通过：setdraworder off&setdraworder on关闭和打开反应器
使用命令：SAVE、QSAVE、SAVEAS、PLOT、PUBLISH

copy

;; Re: Send all hatch/images to background prior to printing & Saving
;; by LeeMac
;; https://www.theswamp.org/index.php?PHPSESSID=klskia7od2ku3u3kf9o6n4nl13&topic=43352.msg507568#msg507568
;;
;; Edited on 10.04.17 by 3dwannab to work with all TEXT, LEADER and DIM objects
;;
(defun setdraworder ( /
exd
ls1
ls2
ls3
obn
sor
spc
)
(if
(setq
        spc (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
        exd (vla-getextensiondictionary spc)
        sor (cond ((catchapply 'vla-getobject (list exd "acad_sortents")))
                ((catchapply 'vla-addobject (list exd "acad_sortents" "acdbsortentstable")))
                )
        )
(progn
        (vlax-for obj spc
                (cond
                        (   (= "AcDbHatch" (setq obn (vla-get-objectname obj)))
                                (setq ls1 (cons obj ls1))
                                )
                        (   (= "AcDbRasterImage" obn)
                                (setq ls2 (cons obj ls2))
                                )
                        (   (= (wcmatch (vla-get-objectname obj) "*Dim*,*Leader*,*Text*") (setq obn (wcmatch (vla-get-objectname obj) "*Dim*,*Leader*,*Text*")))
                                (if (wcmatch (vla-get-objectname obj) "*Dim*,*Leader*,*Text*")
                                        (setq ls3 (cons obj ls3))
                                        )
                                )
                        )
                )
        (if ls1 (vlax-invoke sor 'movetobottom ls1))
        (if ls2 (vlax-invoke sor 'movetobottom ls2))
        (if ls3 (vlax-invoke sor 'movetoTop ls3))
        (princ "\n >>> Draworder Reactor was successful ...\n")(princ)
        )
(princ "\nUnable to retrieve Sortents Table.")
)
(princ)
)
(defun catchapply ( fun arg / rtn )
(if (not (vl-catch-all-error-p (setq rtn (vl-catch-all-apply fun arg)))) rtn)
)
(defun c:setdraworder-on ( )
(if (= 'vlr-command-reactor (type draworder:reactor))
        (if (vlr-added-p draworder:reactor)
                (princ "\nSet Draworder reactor already running.")
                (progn
                        (vlr-add draworder:reactor)
                        (princ "\nSet Draworder reactor enabled.")
                        )
                )
        (progn
                (setq draworder:reactor
                        (vlr-command-reactor "setdraworder-reactor"
                                '(
                                        (:vlr-commandwillstart . draworder:callback)
                                        )
                                )
                        )
                (princ "\nSet Draworder reactor enabled.")
                )
        )
(princ)
)
(defun c:setdraworder-off ( )
(if (= 'vlr-command-reactor (type draworder:reactor))
        (progn
                (vlr-remove draworder:reactor)
                (setq draworder:reactor nil)
                (princ "\nSet Draworder reactor disabled.")
                )
        (princ "\nSet Draworder reactor not running.")
        )
(princ)
)
(defun draworder:callback ( obj arg )
(if (wcmatch (strcase (car arg)) "SAVE,QSAVE,SAVEAS,PLOT,PUBLISH")
        (setdraworder)
        )
(princ)
)
(vl-load-com)
(if (null draworder:reactor)
(setq draworder:reactor (vlr-command-reactor nil '((:vlr-commandwillstart . draworder:callback))))
)
(princ "\n :: Draworder Reactor was loaded ::\n")(princ)

[编程交流] 重定向Lisp例程

发表回复

精选推荐