使用VLA恢复以前的UCS

Aftertouch · 发表于 2022-7-5 16:26:08

大家好，

我正在构建一个代码，它可以实现以下功能：
-当我附加“某物”时，它会将其放置在层XREF\u测试上。
-当前层保持活动状态。
-当我的UCS不是WCS时，它会询问我是否要更改为WCS。

现在问题来了。。。
命令完成后，我希望恢复以前的UCS。

我用红色标记了代码失败的地方。。。

copy


Error: AutoCAD command rejected: "UCS"

使用反应堆时不允许使用“命令”功能。。。
那么我该如何解决这个问题呢？我是如此的接近。。。

copy


;;Command Reactor for Xref/Attachment layer
(if (null myxr-react)
(setq myxr-react (vlr-command-reactor nil         '((:vlr-commandwillstart . myxr-swaplayer)
                                                (:vlr-commandended . myxr-restorelayer)
                                                (:vlr-commandcancelled . myxr-restorelayer))))
)
(defun setormakelayer (layn doc)
(if (null (tblsearch "layer" layn))
        (vla-add (vla-get-layers doc) layn)
)
(vla-put-lock (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) layn ) :vlax-true)
(setvar "clayer" layn)
(if (zerop (getvar 'worlducs))
        (progn
        (ASKFORWCS)
        (setq wisselnaarwcs 1)
        )
)
)
;;commandwillstart callback (reactor commandlist)
(defun myxr-swaplayer (r cl / doc)
(if (member (car cl) '("ATTACH" "XATTACH" "IMAGEATTACH" "DWFATTACH" "PDFATTACH" "POINTCLOUDATTACH" "COORDINATIONMODELATTACH"));allowance for other commands
        (progn
                (setq doc (vlr-document r))
                (vlr-data-set r (getvar "clayer"))
                (if (= 1 (vla-get-activespace doc))
                        (progn
                                (setormakelayer "XREF_TEST" doc)
                        )
                        (progn
                                (setormakelayer "XREF_TEST" doc)
                        )
                )
        )
)
)
;;commandended callback (reactor commandlist)
(defun myxr-restorelayer (r cl)
(if (and (member (car cl) '("ATTACH" "XATTACH" "IMAGEATTACH" "DWFATTACH" "PDFATTACH" "POINTCLOUDATTACH" "COORDINATIONMODELATTACH"))(vlr-data r))
        (progn
                (setvar "clayer" (vlr-data r))
                (if (= wisselnaarwcs 1)
                        (progn
[color="red"]                                        (princ "RESTORE UCS")
                                (command "UCS" "P")[/color]
                                (setq wisselnaarwcs 0)
                        )
                )
        )
        (progn
                (vlr-data-set r nil)
        )
)
)
(defun ASKFORWCS()
(setq reply (ACET-UI-MESSAGE "UCS NAAR WCS? " "UCS system" (+ Acet:YESNO Acet:ICONQuestion)))
;; Yes = 6, No = 7, Cancel = 2
(if (= reply 6)
        (progn
                         (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))(vla-put-ActiveUCS doc (vla-add (vla-get-usercoordinatesystems doc)(vlax-3D-point '(0. 0. 0.))(vlax-3D-point '(1. 0. 0.))(vlax-3D-point '(0. 1. 0.)) "TempWord_UCS"))
                (setq wisselnaarwcs 1)
        )
                (progn
                (ALERT "Nope")
        )
)
(princ)
)
(princ)

Lee Mac · 发表于 2022-7-5 16:31:27

请参见此示例。

Aftertouch · 发表于 2022-7-5 16:32:44

嘿，李，谢谢你的例子。。。
我试着看看是否可以在代码中插入所需的代码。。。但是你的代码对我来说很难理解。
我如何使其适合我的编码？

我在代码中添加了红色代码，但出现了以下错误：

copy


Error: lisp value has no coercion to VARIANT with this type:  ((1.87474 4.632 0.0) (0.846936 0.531695 0.0) (-0.531695 0.846936 0.0))

因此，它确实正确存储UCS，但在放置外部参照并引发此错误后，它不会恢复UCS。

copy


;;Command Reactor for Xref/Attachment layer
(if (null myxr-react)
(setq myxr-react (vlr-command-reactor nil         '((:vlr-commandwillstart . myxr-swaplayer)
                                                (:vlr-commandended . myxr-restorelayer)
                                                (:vlr-commandcancelled . myxr-restorelayer))))
)
(defun setormakelayer (layn doc)
(if (null (tblsearch "layer" layn))
        (vla-add (vla-get-layers doc) layn)
)
(vla-put-lock (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) layn ) :vlax-true)
(setvar "clayer" layn)
(if (zerop (getvar 'worlducs))
        (progn
        (ASKFORWCS)
        )
)
)
;;commandwillstart callback (reactor commandlist)
(defun myxr-swaplayer (r cl / doc)
(if (member (car cl) '("ATTACH"));allowance for other commands
        (progn
                (setq doc (vlr-document r))
                (vlr-data-set r (getvar "clayer"))
                (if (= 1 (vla-get-activespace doc))
                        (progn
                                (setormakelayer "XREF" doc)
                        )
                        (progn
                                (setormakelayer "XREF" doc)
                        )
                )
        )
)
(if (member (car cl) '("XATTACH" "DWFATTACH"));allowance for other commands
        (progn
                (setq doc (vlr-document r))
                (vlr-data-set r (getvar "clayer"))
                (if (= 1 (vla-get-activespace doc))
                        (progn
                                (setormakelayer "XREF-DWG" doc)
                        )
                        (progn
                                (setormakelayer "XREF-DWG" doc)
                        )
                )
        )
)
(if (member (car cl) '("IMAGEATTACH"));allowance for other commands
        (progn
                (setq doc (vlr-document r))
                (vlr-data-set r (getvar "clayer"))
                (if (= 1 (vla-get-activespace doc))
                        (progn
                                (setormakelayer "XREF-IMAGE" doc)
                        )
                        (progn
                                (setormakelayer "XREF-IMAGE" doc)
                        )
                )
        )
)
(if (member (car cl) '("PDFATTACH"));allowance for other commands
        (progn
                (setq doc (vlr-document r))
                (vlr-data-set r (getvar "clayer"))
                (if (= 1 (vla-get-activespace doc))
                        (progn
                                (setormakelayer "XREF-PDF" doc)
                        )
                        (progn
                                (setormakelayer "XREF-PDF" doc)
                        )
                )
        )
)
(if (member (car cl) '("POINTCLOUDATTACH"));allowance for other commands
        (progn
                (setq doc (vlr-document r))
                (vlr-data-set r (getvar "clayer"))
                (if (= 1 (vla-get-activespace doc))
                        (progn
                                (setormakelayer "XREF-POINTCLOUD" doc)
                        )
                        (progn
                                (setormakelayer "XREF-POINTCLOUD" doc)
                        )
                )
        )
)
(if (member (car cl) '("COORDINATIONMODELATTACH"));allowance for other commands
        (progn
                (setq doc (vlr-document r))
                (vlr-data-set r (getvar "clayer"))
                (if (= 1 (vla-get-activespace doc))
                        (progn
                                (setormakelayer "XREF-COORDINATIONMODEL" doc)
                        )
                        (progn
                                (setormakelayer "XREF-COORDINATIONMODEL" doc)
                        )
                )
        )
)
)
;;commandended callback (reactor commandlist)
(defun myxr-restorelayer (r cl)
(if (and (member (car cl) '("ATTACH" "XATTACH" "IMAGEATTACH" "DWFATTACH" "PDFATTACH" "POINTCLOUDATTACH" "COORDINATIONMODELATTACH"))(vlr-data r))
        (progn
                (setvar "clayer" (vlr-data r))
                (if (= wisselnaarwcs 1)
                        (progn
                                (ALERT "Vergeet niet je UCS terug te zetten!")
[color="red"]                                        (vla-put-activeucs (ucsr:acdoc)(vla-item (vla-get-usercoordinatesystems (ucsr:acdoc)) ucsr:prevucs))[/color]
                                (setq wisselnaarwcs 0)
                        )
                )
        )
        (progn
                (vlr-data-set r nil)
        )
)
)
(defun ASKFORWCS()
(setq reply (ACET-UI-MESSAGE "Het huidige coördinaten-stelsel is niet 'World'\nCoördinaten-stelsen aanpassen naar 'World'?" "UCS SYSTEM" (+ Acet:YESNO Acet:ICONQuestion)))
;; Yes = 6, No = 7, Cancel = 2
(if (= reply 6)
        (progn
[color="red"]                        (setq ucsr:prevucs (mapcar 'getvar '(ucsorg ucsxdir ucsydir)))[/color]
                         (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))(vla-put-ActiveUCS doc (vla-add (vla-get-usercoordinatesystems doc)(vlax-3D-point '(0. 0. 0.))(vlax-3D-point '(1. 0. 0.))(vlax-3D-point '(0. 1. 0.)) "TempWord_UCS"))
                (setq wisselnaarwcs 1)
        )
                (progn
                ;(ALERT "Nope")
        )
)
(princ)
)
[color="red"](defun ucsr:acdoc nil
   (eval (list 'defun 'ucsr:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
   (ucsr:acdoc)
)[/color]

（普林斯）

Lee Mac · 发表于 2022-7-5 16:37:20

在我的代码中，变量ucsr:prevucs存储活动UCS的名称，或者存储定义活动UCS的向量列表（如果未命名）。然后，还原此UCS的代码测试此变量的值是字符串还是列表，并进行相应的操作。在代码中，变量ucsr:prevucs将始终存储向量列表，但是，您正在尝试恢复命名UCS。

Roy_043 · 发表于 2022-7-5 16:39:49

您不能在reactor回调中使用命令，但可以使用sendcommand方法。我认为它可以用于Aftertouch的代码：

copy

(vla-sendcommand docObject "_UCS _Previous ")

Aftertouch · 发表于 2022-7-5 16:44:41

谢谢大家的回复。

我混合了我的代码，李的代码和罗伊的想法，

代码现在真的可以工作了！耶：-）

即使它在命令行中给我带来了一个错误：

copy


Error: Automation Error. Object is referenced by other object(s)

错误是由代码引起的，用红色标记，它抛出错误，但它仍按我的意愿删除UCS。
有没有办法摆脱这个错误？？？

下面是代码：

copy


;;Command Reactor for Xref/Attachment layer
(if (null myxr-react)
(setq myxr-react (vlr-command-reactor nil         '((:vlr-commandwillstart . myxr-swaplayer)
                                                (:vlr-commandended . myxr-restorelayer)
                                                (:vlr-commandcancelled . myxr-restorelayer))))
)
(defun setormakelayer (layn doc)
(if (null (tblsearch "layer" layn))
        (vla-add (vla-get-layers doc) layn)
)
(vla-put-lock (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) layn ) :vlax-true)
(setvar "clayer" layn)
(if (zerop (getvar 'worlducs))
        (progn
        (ASKFORWCS)
        )
)
)
;;commandwillstart callback (reactor commandlist)
(defun myxr-swaplayer (r cl / doc)
(setvar "CMDECHO" 0)
(if (member (car cl) '("ATTACH"));allowance for other commands
        (progn
                (setq doc (vlr-document r))
                (vlr-data-set r (getvar "clayer"))
                (if (= 1 (vla-get-activespace doc))
                        (progn
                                (setormakelayer "XREF" doc)
                        )
                        (progn
                                (setormakelayer "XREF" doc)
                        )
                )
        )
)
(if (member (car cl) '("XATTACH" "DWFATTACH"));allowance for other commands
        (progn
                (setq doc (vlr-document r))
                (vlr-data-set r (getvar "clayer"))
                (if (= 1 (vla-get-activespace doc))
                        (progn
                                (setormakelayer "XREF-DWG" doc)
                        )
                        (progn
                                (setormakelayer "XREF-DWG" doc)
                        )
                )
        )
)
(if (member (car cl) '("IMAGEATTACH"));allowance for other commands
        (progn
                (setq doc (vlr-document r))
                (vlr-data-set r (getvar "clayer"))
                (if (= 1 (vla-get-activespace doc))
                        (progn
                                (setormakelayer "XREF-IMAGE" doc)
                        )
                        (progn
                                (setormakelayer "XREF-IMAGE" doc)
                        )
                )
        )
)
(if (member (car cl) '("PDFATTACH"));allowance for other commands
        (progn
                (setq doc (vlr-document r))
                (vlr-data-set r (getvar "clayer"))
                (if (= 1 (vla-get-activespace doc))
                        (progn
                                (setormakelayer "XREF-PDF" doc)
                        )
                        (progn
                                (setormakelayer "XREF-PDF" doc)
                        )
                )
        )
)
(if (member (car cl) '("POINTCLOUDATTACH"));allowance for other commands
        (progn
                (setq doc (vlr-document r))
                (vlr-data-set r (getvar "clayer"))
                (if (= 1 (vla-get-activespace doc))
                        (progn
                                (setormakelayer "XREF-POINTCLOUD" doc)
                        )
                        (progn
                                (setormakelayer "XREF-POINTCLOUD" doc)
                        )
                )
        )
)
(if (member (car cl) '("COORDINATIONMODELATTACH"));allowance for other commands
        (progn
                (setq doc (vlr-document r))
                (vlr-data-set r (getvar "clayer"))
                (if (= 1 (vla-get-activespace doc))
                        (progn
                                (setormakelayer "XREF-COORDINATIONMODEL" doc)
                        )
                        (progn
                                (setormakelayer "XREF-COORDINATIONMODEL" doc)
                        )
                )
        )
)
)
;;commandended callback (reactor commandlist)
(defun myxr-restorelayer (r cl)
(if (and (member (car cl) '("ATTACH" "XATTACH" "IMAGEATTACH" "DWFATTACH" "PDFATTACH" "POINTCLOUDATTACH" "COORDINATIONMODELATTACH"))(vlr-data r))
        (progn
                (setvar "clayer" (vlr-data r))
                (if (= wisselnaarwcs 1)
                        (progn
                                (setq acadObj (vlax-get-acad-object))
                                (setq doc (vla-get-ActiveDocument acadObj))
                                (vla-sendcommand doc "_UCS _P ")
                                (setq wisselnaarwcs 0)
                        )
                        (progn
                        )
                )
        )
        (progn
                (vlr-data-set r nil)
        )
)
[color="red"]        (if (tblsearch "ucs" "WCS")
        (progn
        (vla-delete (vla-item (vla-get-usercoordinatesystems doc) "WCS"))
        )
        (progn
        )
)[/color]
(setvar "CMDECHO" 1)
)
(defun ASKFORWCS()
(setq reply (ACET-UI-MESSAGE "Het huidige coördinaten-stelsel is niet 'World'\nCoördinaten-stelsen aanpassen naar 'World'?" "UCS SYSTEM" (+ Acet:YESNO Acet:ICONQuestion)))
;; Yes = 6, No = 7, Cancel = 2
(if (= reply 6)
        (progn
                         (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))(vla-put-ActiveUCS doc (vla-add (vla-get-usercoordinatesystems doc)(vlax-3D-point '(0. 0. 0.))(vlax-3D-point '(1. 0. 0.))(vlax-3D-point '(0. 1. 0.)) "WCS"))
                (setq wisselnaarwcs 1 )
        )
                (progn
                ;(ALERT "Nope")
        )
)
(princ)
)
(princ)

Tharwat · 发表于 2022-7-5 16:45:37

你好

你的重复代码太多了！但无论如何，这是我给你的mods，希望它能如你所愿工作。

注意：请尝试新图纸上的代码。

copy


;;  Command Reactor for Xref/Attachment layer
(if (null myxr-react)
 (setq myxr-react (vlr-command-reactor nil '((:vlr-commandwillstart . myxr-swaplayer)
                                             (:vlr-commandended . myxr-restorelayer)
                                             (:vlr-commandcancelled . myxr-restorelayer)
                                             )
                    )
       )
 )
;;                                ;;
(defun setormakelayer (layn doc / lay)
 (if (setq lay (vla-add (vla-get-layers doc) layn))
   (vla-put-lock lay :vlax-true)
   )
 (setq *myxrClayer* (getvar 'CLAYER))
 (setvar "clayer" layn)
 (if (zerop (getvar 'worlducs))
   (askforwcs doc)
 )
)
;;    commandwillstart callback (reactor commandlist)
(defun myxr-swaplayer (r cl / doc cmd)
 (setvar "CMDECHO" 0)
 (setq doc (vlr-document r)
       cmd (car cl)
       )
 (vlr-data-set r (getvar "clayer"))
 (cond ((= cmd "ATTACH")                      (setormakelayer "XREF" doc))
       ((member cmd '("XATTACH" "DWFATTACH")) (setormakelayer "XREF-DWG" doc))
       ((= cmd "IMAGEATTACH")                 (setormakelayer "XREF-IMAGE" doc))
       ((= cmd "PDFATTACH")                   (setormakelayer "XREF-PDF" doc))
       ((= cmd "POINTCLOUDATTACH")            (setormakelayer "XREF-POINTCLOUD" doc))
       ((= cmd "COORDINATIONMODELATTACH")     (setormakelayer "XREF-COORDINATIONMODEL" doc))
       )
)
;;    commandended callback (reactor commandlist)
(defun myxr-restorelayer (r cl)
 (if (member (car cl) '("ATTACH" "XATTACH" "IMAGEATTACH" "DWFATTACH" "PDFATTACH"
                        "POINTCLOUDATTACH" "COORDINATIONMODELATTACH" ) )
   (progn
     (and *myxrClayer* (setvar "clayer" *myxrClayer*) (setq *myxrClayer* nil))
     (if (= wisselnaarwcs 1)
       (progn
         (vla-sendcommand (vlr-document r) "_UCS _P ")
         (setq wisselnaarwcs 0)
       )
     )
   )
 )
 (if (tblsearch "ucs" "WCS")
     (vla-delete (vla-item (vla-get-usercoordinatesystems doc) "WCS")
   )
 )
 (setvar "CMDECHO" 1)
)
;;                                ;;
(defun askforwcs (doc / reply )
 (setq reply (acet-ui-message "Het huidige co?rdinaten-stelsel is niet 'World'\nCo?rdinaten-stelsen aanpassen naar 'World'?"
               "UCS SYSTEM" (+ acet:yesno acet:iconquestion))
 )
 ;; Yes = 6, No = 7, Cancel = 2
 (if (= reply 6)
   (progn
     (vla-put-activeucs doc
       (vla-add (vla-get-usercoordinatesystems doc)
                (vlax-3d-point '(0. 0. 0.))
                (vlax-3d-point '(1. 0. 0.))
                (vlax-3d-point '(0. 1. 0.))
                "WCS"
       )
     )
     (setq wisselnaarwcs 1)
   )
   ;; (ALERT "Nope")
 )
 (princ)
) (vl-load-com)

Aftertouch · 发表于 2022-7-5 16:50:35

嘿Tharwat，

感谢代码中的清理。
这给我带来了一个小错误，但我设法纠正了那个错误。
我用红色标记了它。

现在，您的代码可以像以前一样工作（但现在已清理完毕）：-），但仍然会引发错误：
我这次用绿色标记了原因。：-）
注意：Is仍然完成了我想要的所有事情。。。所以我不明白为什么会出现错误。。。因为它仍然执行delete函数，并实际删除WCS。。。

copy


Error: Automation Error. Object is referenced by other object(s)

copy


;;  Command Reactor for Xref/Attachment layer
(if (null myxr-react)
 (setq myxr-react (vlr-command-reactor nil '((:vlr-commandwillstart . myxr-swaplayer)
                                             (:vlr-commandended . myxr-restorelayer)
                                             (:vlr-commandcancelled . myxr-restorelayer)
                                             )
                    )
       )
 )
;;                                ;;
(defun setormakelayer (layn doc / lay)
 (if (setq lay (vla-add (vla-get-layers doc) layn))
   (vla-put-lock lay :vlax-true)
   )
 (setq *myxrClayer* (getvar 'CLAYER))
 (setvar "clayer" layn)
 (if (zerop (getvar 'worlducs))
   (askforwcs doc)
 )
)
;;    commandwillstart callback (reactor commandlist)
(defun myxr-swaplayer (r cl / doc cmd)
 (setvar "CMDECHO" 0)
 (setq doc (vlr-document r)
       cmd (car cl)
       )
 (vlr-data-set r (getvar "clayer"))
 (cond ((= cmd "ATTACH")                      (setormakelayer "XREF" doc))
       ((member cmd '("XATTACH" "DWFATTACH")) (setormakelayer "XREF-DWG" doc))
       ((= cmd "IMAGEATTACH")                 (setormakelayer "XREF-IMAGE" doc))
       ((= cmd "PDFATTACH")                   (setormakelayer "XREF-PDF" doc))
       ((= cmd "POINTCLOUDATTACH")            (setormakelayer "XREF-POINTCLOUD" doc))
       ((= cmd "COORDINATIONMODELATTACH")     (setormakelayer "XREF-COORDINATIONMODEL" doc))
       )
)
;;    commandended callback (reactor commandlist)
(defun myxr-restorelayer (r cl)
 (if (member (car cl) '("ATTACH" "XATTACH" "IMAGEATTACH" "DWFATTACH" "PDFATTACH"
                        "POINTCLOUDATTACH" "COORDINATIONMODELATTACH" ) )
   (progn
     (and *myxrClayer* (setvar "clayer" *myxrClayer*) (setq *myxrClayer* nil))
     (if (= wisselnaarwcs 1)
       (progn
         (vla-sendcommand (vlr-document r) "_UCS _P ")
         (setq wisselnaarwcs 0)
       )
     )
   )
 )
[color="seagreen"]  (if (tblsearch "ucs" "WCS")
     (vla-delete (vla-item (vla-get-usercoordinatesystems [color="red"](vlr-document r)[/color]) "WCS") [color="red"];replaced doc for (vlr-document r)[/color]
   )
 )[/color]
 (setvar "CMDECHO" 1)
)
;;                                ;;
(defun askforwcs (doc / reply )
 (setq reply (acet-ui-message "Het huidige co?rdinaten-stelsel is niet 'World'\nCo?rdinaten-stelsen aanpassen naar 'World'?"
               "UCS SYSTEM" (+ acet:yesno acet:iconquestion))
 )
 ;; Yes = 6, No = 7, Cancel = 2
 (if (= reply 6)
   (progn
     (vla-put-activeucs doc
       (vla-add (vla-get-usercoordinatesystems doc)
                (vlax-3d-point '(0. 0. 0.))
                (vlax-3d-point '(1. 0. 0.))
                (vlax-3d-point '(0. 1. 0.))
                "WCS"
       )
     )
     (setq wisselnaarwcs 1)
   )
   ;; (ALERT "Nope")
 )
 (princ)
) (vl-load-com)

Tharwat · 发表于 2022-7-5 16:52:09

正如预期的那样，我修改过的代码和您在第8篇文章中发布的代码都能正常工作。

Aftertouch · 发表于 2022-7-5 16:57:01

嘿Tharwat，

这两个代码似乎都有效，但当我检查命令栏时，我看到了以下内容：

您的代码：

copy


Command: _XATTACH
Overlay Xref "TESTDWG": G:\PROJECTS\TESTDWG.dwg
"TESTDWG" loaded.
Error: bad argument type: VLA-OBJECT nilPress ENTER to continue:
Command: _UCS
Current ucs name:  WCS
Specify origin of UCS or [Face/NAmed/OBject/Previous/View/World/X/Y/Z/ZAxis] <World>: _P
Error: bad argument type: VLA-OBJECT nil

您的代码已修改

copy


Command: _XATTACH
Overlay Xref "TESTDWG": G:\PROJECTS\TESTDWG.dwg
"TESTDWG" loaded.
Error: Automation Error. Object is referenced by other object(s)Press ENTER to continue:
Command: _UCS
Current ucs name:  WCS
Specify origin of UCS or [Face/NAmed/OBject/Previous/View/World/X/Y/Z/ZAxis] <World>: _P

[编程交流] 使用VLA恢复以前的UCS

发表回复

精选推荐