+ Reply to Thread
Page 1 of 3 1 2 3 LastLast
Results 1 to 10 of 22
  1. #1
    Senior Member
    Discipline
    Civil
    Aftertouch's Discipline Details
    Discipline
    Civil
    Details
    Engineer
    Using
    AutoCAD 2017
    Join Date
    Jul 2016
    Location
    Netherlands
    Posts
    148

    Default Restore previous UCS using VLA

    Registered forum members do not see this ad.

    Hey All,

    I'm building a code that does the following:
    - When i attach 'something' it places it on the layer XREF_TEST.
    - The current layer stays active.
    - When my UCS is not WCS, it asks me if i want to change to WCS.

    Now the problem...
    When the command is complete, i want to restore the previous UCS.

    I marked the code in RED where my code fails...

    Code:
    Error: AutoCAD command rejected: "UCS"
    A 'command' function is not allowed when using reactors...
    So how can i solve this? Im so damn close...

    Code:
    ;;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
    					(princ "RESTORE UCS")
    					(command "UCS" "P")
    					(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)
    Last edited by Aftertouch; 20th Apr 2017 at 01:16 pm.

  2. #2
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Windows 7 Ultimate (32-bit)
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2013
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    19,227
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

  3. #3
    Senior Member
    Discipline
    Civil
    Aftertouch's Discipline Details
    Discipline
    Civil
    Details
    Engineer
    Using
    AutoCAD 2017
    Join Date
    Jul 2016
    Location
    Netherlands
    Posts
    148

    Default

    Hey Lee, thanks for the example...
    I've tried to see if i could insert the needed code into my code... but your code is hard to understand for me.
    How would i make it fit into my coding?

    I added the codes in RED to my code, but this error follows:
    Code:
    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))
    So it DOES store the UCS correctly, but doesnt recovery it after the XREF is placed and throws me this error.

    Code:
    ;;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!")
    					(vla-put-activeucs (ucsr:acdoc)(vla-item (vla-get-usercoordinatesystems (ucsr:acdoc)) ucsr:prevucs))
    					(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
    			(setq ucsr:prevucs (mapcar 'getvar '(ucsorg ucsxdir ucsydir)))
      			(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)
    )
    
    (defun ucsr:acdoc nil
        (eval (list 'defun 'ucsr:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
        (ucsr:acdoc)
    )
    (princ)
    Last edited by Aftertouch; 20th Apr 2017 at 01:33 pm.

  4. #4
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Windows 7 Ultimate (32-bit)
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2013
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    19,227

    Default

    In my code, the variable ucsr:prevucs stores either the name of the active UCS, or a list of vectors defining the active UCS if unnamed. The code which restores this UCS then tests whether the value of this variable is a string or a list, and operates accordingly. In your code, the variable ucsr:prevucs will always store a list of vectors, however, you are attempting to restore a named UCS.
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

  5. #5
    Senior Member
    Using
    not applicable
    Join Date
    Jun 2016
    Posts
    445

    Default

    You can't use commands in reactor callbacks but the sendcommand method can be used. I think it can work for Aftertouch's code:
    Code:
    (vla-sendcommand docObject "_UCS _Previous ")
    BricsCAD 16

  6. #6
    Senior Member
    Discipline
    Civil
    Aftertouch's Discipline Details
    Discipline
    Civil
    Details
    Engineer
    Using
    AutoCAD 2017
    Join Date
    Jul 2016
    Location
    Netherlands
    Posts
    148

    Default

    Thanks all for the replies.

    I mixed both my code, with the code of Lee Mac, and the idea of Roy,

    And the code actualy works now! Yay :-)

    Even tho it throws me an error in the command line:
    Code:
    Error: Automation Error. Object is referenced by other object(s)
    The error is caused by the code, marked in RED, it throws me the error, but it still deletes the UCS as i want it to.
    Any idea's how to get rid of this error???

    This is the code now:
    Code:
    ;;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)
    		)
    	)
    	(if (tblsearch "ucs" "WCS")
    		(progn
    		(vla-delete (vla-item (vla-get-usercoordinatesystems doc) "WCS"))
    		)
    		(progn
    		)
    	)
    	(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)

  7. #7
    Luminous Being Tharwat's Avatar
    Discipline
    Mechanical
    Tharwat's Discipline Details
    Occupation
    MEP AutoCAD Draughtsman
    Discipline
    Mechanical
    Details
    HVAC, Drainage, Water Supply, Fire Fighting and a little about Electricity.
    Using
    AutoCAD 2015
    Join Date
    Oct 2009
    Location
    Great Syria , Living in Abu Dhabi
    Posts
    5,930

    Default

    Hi,

    You have too much repeated codes! But anyway here is my mods for you and hope it works as you wish.

    NOTE: Please try the codes on new drawing.
    Code:
    ;;  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)

  8. #8
    Senior Member
    Discipline
    Civil
    Aftertouch's Discipline Details
    Discipline
    Civil
    Details
    Engineer
    Using
    AutoCAD 2017
    Join Date
    Jul 2016
    Location
    Netherlands
    Posts
    148

    Default

    Hey Tharwat,

    Thanks for the cleanup in the code.
    It threw me a small error, but i managed to fix that one.
    I marked it in RED.

    Now your code works as it did earlier (but cleaned up now) :-), but still throws me the error:
    I marked the cause in GREEN this time. :-)
    NOTE: Is still DOES complete all things i want... so i dont understand why it gives the error... as it still executes the delete function, and actualy deletes the WCS...

    Code:
    Error: Automation Error. Object is referenced by other object(s)
    Code:
    ;;  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 (vlr-document r)) "WCS") ;replaced doc for (vlr-document r)
        )
      )
      (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)

  9. #9
    Luminous Being Tharwat's Avatar
    Discipline
    Mechanical
    Tharwat's Discipline Details
    Occupation
    MEP AutoCAD Draughtsman
    Discipline
    Mechanical
    Details
    HVAC, Drainage, Water Supply, Fire Fighting and a little about Electricity.
    Using
    AutoCAD 2015
    Join Date
    Oct 2009
    Location
    Great Syria , Living in Abu Dhabi
    Posts
    5,930

    Default

    It works here as expected, the codes that I have modified and the one that you have posted in Post# 8.

  10. #10
    Senior Member
    Discipline
    Civil
    Aftertouch's Discipline Details
    Discipline
    Civil
    Details
    Engineer
    Using
    AutoCAD 2017
    Join Date
    Jul 2016
    Location
    Netherlands
    Posts
    148

    Default

    Registered forum members do not see this ad.

    Hey Tharwat,

    Both off the codes seem to work, but when i check the command bar, i see this:

    YOUR CODE:
    Code:
    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
    YOUR CODE MODDED
    Code:
    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

Similar Threads

  1. Replies: 9
    Last Post: 12th Jan 2016, 01:48 pm
  2. Hi, Restore to WCS ?
    By andy_lee in forum AutoLISP, Visual LISP & DCL
    Replies: 8
    Last Post: 24th Aug 2014, 03:10 am
  3. Freeze all layers except current, and restore previous state
    By freddy0663 in forum AutoLISP, Visual LISP & DCL
    Replies: 12
    Last Post: 7th Jun 2013, 02:24 am
  4. Restore Osnap's
    By Seath in forum AutoLISP, Visual LISP & DCL
    Replies: 21
    Last Post: 27th Oct 2008, 06:09 am

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts