重定向Lisp例程乐筑天下 - Powered by Discuz! Archiver

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

重定向Lisp例程

我正在尝试编写一个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例程

(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

;; 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。

(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命令将开始监视命令行，以获取要触发事件的命令，例如：
(if (wcmatch (strcase (car arg)) "SAVE,QSAVE,SAVEAS,PLOT")
(setdraworder)
)

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

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

我的命令使用TEXTTOFRONT调用DrawOrder Reactor
;; 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
;; 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)

页: [1]

乐筑天下's Archiver

重定向Lisp例程