AutoLISP: Globally Change XREF Attachment Type

If you need to Changeall of the way in which XREF’s are attached this routine is for you. This routine will change all XREFs in a drawing to either “Overlay” or “Attached.”

Here’s How:

  • X2A <enter> = All XREFs to “Attached”

OR

  • X2O <enter> = All XREFs to “Overlay”

That’s it!!!!

~enjoy


;*****************************************************************************************************************
;Xref to Attach/Overlay										**
;Written by: Chris Wade										**
; 			  									**
;Version 2.1a  											**
;12/07/2011	  										**
;		 			  							**
;- Adjusted code to temporarily disable all reactors to prevent interference with LISP routine. **
; 			  									**
;Version 2.1	  										**
;12/05/2011	  										**
;	 			  								**
;- Changes that attachment type for all XRefs. 							**
;- X2A - Changes all xrefs to attached method.							**
;- X2O - Changes all xrefs to overlay method.							**
;	 			  								**
;- Known Limitations:		  								**
;- Viewport specific layer overrides may not be restored.					**
;	  	  	  									**
;*****************************************************************************************************************
(defun C:x2a ()
  (xmethodflip "a")
)
(defun C:x2o ()
  (xmethodflip "o")
)
(defun xmethodflip (mode	/	    *ACAD_DOC*	*PaperSpace*
		    *ModelSpace*	    *Active*	*ActiveID*
		    allReactors	cLayout	    BlockDef	xObj2
		    SS2		LS	    Temp	Clip
		    ClipLength	ClipCount   ClipTemp	Clip1
		    Clip2	xIsClipped  XNameList	BlockCollection
		    xInsPt	xLayer	    xScaleX	xScaleY
		    xScaleZ	xRotation   xPath	Obj2
		    xObj	xObjName    xLayout	xOwnerID
		   )			; Mode - O = Overlay / A = Attach
  (vl-load-com)
  (setvar "cmdecho" 0)
  (setq	*ACAD_DOC*   (vla-get-ActiveDocument (vlax-get-acad-object))
	*PaperSpace* (vla-get-paperspace *ACAD_DOC*)
	*ModelSpace* (vla-get-modelspace *ACAD_DOC*)
  )
  (cond
    ((or (= (getvar "tilemode") 1) (/= (getvar "cvport") 1))
     (setq xLayout *ModelSpace*)
    )
    ((and (= (getvar "tilemode") 0) (= (getvar "cvport") 1))
     (setq xLayout *PaperSpace*)
    )
  )
					;Supporting Functions
  (defun x2a_NotNested (name / SS)
    (setq
      ss (ssget "_X" (list (cons 2 name) (cons 410 (getvar "ctab"))))
    )
    SS
  )
  (defun x2a_r2d (rad /)
    (/ (* rad 180) pi)
  )
  (defun x2a_GetXclip (ename / __XClipBoundary elist xlist _xang _xnor)
; Code from Lee Mac @ http://www.theswamp.org/index.php?topic=39201.msg444239#msg444239
;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

    (defun mxv (m v)
      (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
    )

    ;; Matrix x Matrix - Vladimir Nesterovsky
    ;; Args: m,n - nxn matrices

    (defun mxm (m n)
      ((lambda (a) (mapcar '(lambda (r) (mxv a r)) m)) (trp n))
    )

    ;; Matrix Transpose - Doug Wilson
    ;; Args: m - nxn matrix

    (defun trp (m) (apply 'mapcar (cons 'list m)))

    (defun __XClipBoundary (ename / xdict)
      (if
	(setq xdict (cdr (assoc 360 (entget ename))))
	 (__XClipBoundary xdict)
	 (if
	   (and
	     (eq "SPATIAL_FILTER"
		 (cdr (assoc 0 (setq ename (entget ename))))
	     )
	     (eq 1 (cdr (assoc 71 ename)))
	   )
	    (
	     (lambda (massoc) (massoc 10 ename))
	      (lambda (key elist / item)
		(if (setq item (assoc key elist))
		  (cons (cdr item) (massoc key (cdr (member item elist))))
		)
	      )
	    )
	 )
      )
    )

    (defun __dxf (key lst) (cdr (assoc key lst)))

    (setq elist	(entget ename)
	  _xang	(__dxf 50 elist)
	  _xnor	(__dxf 210 elist)
    )
    (if	(setq xlist (__XClipBoundary ename))
      (
       (lambda (matrix)
	 (
	  (lambda (vector)
	    (mapcar
	      (function
		(lambda	(point)
		  (mapcar '+ (mxv matrix point) vector)
		)
	      )
	      xlist
	    )
	  )
	   (mapcar '-
		   (trans (__dxf 10 elist) _xnor 0)
		   (mxv	matrix
			(__dxf 10 (tblsearch "BLOCK" (__dxf 2 elist)))
		   )
	   )
	 )
       )
	(mxm
	  (mapcar
	    (function
	      (lambda (v) (trans v 0 _xnor t))
	    )
	    '(
	      (1.0 0.0 0.0)
	      (0.0 1.0 0.0)
	      (0.0 0.0 1.0)
	     )
	  )
	  (mxm
	    (list
	      (list (cos _xang) (sin (- _xang)) 0.0)
	      (list (sin _xang) (cos _xang) 0.0)
	      (list 0.0 0.0 1.0)
	    )
	    (list
	      (list (__dxf 41 elist) 0.0 0.0)
	      (list 0.0 (__dxf 42 elist) 0.0)
	      (list 0.0 0.0 (__dxf 43 elist))
	    )
	  )
	)
      )
    )
  )
  ;;  by CAB 10/05/2007
  ;;  Expects pts to be a list of 2D or 3D points
  ;;  Returns new pline object
  (defun x2a_makePline (spc pts)
    ;;  flatten the point list to 2d
    (if	(= (length (car pts)) 2)	; 2d point list
      (setq pts (apply 'append pts))
      (setq
	pts (apply 'append
		   (mapcar '(lambda (x) (list (car x) (cadr x))) pts)
	    )
      )
    )
    (setq
      pts (vlax-make-variant
	    (vlax-safearray-fill
	      (vlax-make-safearray
		vlax-vbdouble
		(cons 0 (1- (length pts)))
	      )
	      pts
	    )
	  )
    )
    (vla-addlightweightpolyline spc pts)
  )
;Code to determine if layerstate is present provided by AlanJT
  (defun x2a_isLayerStatePresent (doc layerstate / state)
    (if	(not
	  (vl-catch-all-error-p
	    (vl-catch-all-apply
	      '(lambda (/)
		 (setq state
			(vla-item (vla-item (vla-GetExtensionDictionary
					      (vla-get-layers doc)
					    )
					    "ACAD_LAYERSTATES"
				  )
				  layerstate
			)
		 )
	       )
	    )
	  )
	)
      state
    )
  )
;End of Supporting Functions
  (vla-StartUndoMark *ACAD_DOC*)
  (setq allReactors (apply 'append (mapcar 'cdr (vlr-reactors))))
  (if allReactors
    (mapcar 'vlr-remove allReactors)
  )
  ; temporarily disable all reactors - Code by roy_043 @ http://www.theswamp.org/index.php?topic=34597.msg408535#msg408535
  (setq cLayout (vla-get-activelayout *ACAD_DOC*))
  (vlax-for L (vla-get-layouts *ACAD_DOC*)
    (vla-put-activelayout *ACAD_DOC* L)
    (setq SS (ssget "_X"
		    (list '(0 . "INSERT") (cons 410 (getvar "ctab")))
	     )
    )
    (cond
      (SS
       (setq LS	1
	     BlockCollection
	      (vla-get-blocks *ACAD_DOC*)
       )
       (while (x2a_isLayerStatePresent
		*ACAD_DOC*
		(strcat "X2A-" (rtos LS 2 0))
	      )
	 (setq LS (+ LS 1))
       )
       (vl-cmdf	"._-layer"
		"_a"
		"_save"
		(strcat "X2A-" (rtos LS 2 0))
		""
		""
		""
       )
       ((lambda	(i / Ent)
	  (while (setq Ent (ssname SS (setq i (1+ i))))
	    (setq xObj2 (vlax-ename->vla-object Ent))
	    (cond
	      (xObj2
	       (setq BlockDef (vla-item	BlockCollection
					(vla-get-name xObj2)
			      )
	       )
	       (cond
		 ((= (vla-get-isxref BlockDef) :vlax-true)
		  (setq	xRname (vla-get-name xObj2)
			xPath  (vla-get-path BlockDef)
			SS2    (x2a_NotNested xRname)
		  )
		  ((Lambda (I2 / Ent2)
		     (While
		       (Setq Ent2 (Ssname Ss2 (Setq I2 (1+ I2))))
			(Setq Xobj	 (Vlax-ename->vla-object Ent2)
			      Xinspt	 (Cons (Vlax-safearray->list
						 (Variant-value
						   (Vla-get-insertionpoint Xobj)
						 )
					       )
					       Xinspt
					 )
			      Xownerid	 (Cons (Vla-get-ownerid Xobj)
					       Xownerid
					 )
			      Xscalex	 (Cons (Vla-get-xscalefactor Xobj)
					       Xscalex
					 )
			      Xscaley	 (Cons (Vla-get-yscalefactor Xobj)
					       Xscaley
					 )
			      Xscalez	 (Cons (Vla-get-zscalefactor Xobj)
					       Xscalez
					 )
			      Xrotation	 (Cons (Vla-get-rotation Xobj)
					       Xrotation
					 )
			      Xlayer	 (Cons (Vla-get-layer Xobj) Xlayer)
			      Xisclipped (Cons
					   (X2a_getxclip
					     (Vlax-vla-object->ename Xobj)
					   )
					   Xisclipped
					 )
			)
		     )
		   )
		    -1
		  )
		  (vla-detach BlockDef)
		  ((Lambda (Ct2 / Ent2)
		     (While
		       (Setq Ent2 (Ssname Ss2 (Setq Ct2 (1+ Ct2))))
			(cond
			  ((or (< (nth Ct2 xScaleX) 0)
			       (< (nth Ct2 xScaleY) 0)
			       (< (nth Ct2 xScaleZ) 0)
			   )		; This is put here for xRefs that have been mirrored.
			   (vl-cmdf "._-xref"
				    (strcat "_" mode)
				    xPath
				    (nth Ct2 xInsPt)
				    (nth Ct2 xScaleX)
				    (nth Ct2 xScaleY)
				    (x2a_r2d (nth Ct2 xRotation))
			   )
			   (setq
			     Obj2 (vlax-ename->vla-object (entlast))
			   )
			  )
			  (T
			   (cond
			     ((= (strcase mode) "O")
			      (setq Obj2
				     (vla-attachexternalreference
				       xLayout
				       xPath
				       (vl-filename-base xPath)
				       (vlax-3D-point (nth Ct2 xInsPt))
				       (nth Ct2 xScaleX)
				       (nth Ct2 xScaleY)
				       (nth Ct2 xScaleZ)
				       (nth Ct2 xRotation)
				       :vlax-true
				     )
			      )
			     )
			     ((= (strcase mode) "A")
			      (setq Obj2
				     (vla-attachexternalreference
				       xLayout
				       xPath
				       (vl-filename-base xPath)
				       (vlax-3D-point (nth Ct2 xInsPt))
				       (nth Ct2 xScaleX)
				       (nth Ct2 xScaleY)
				       (nth Ct2 xScaleZ)
				       (nth Ct2 xRotation)
				       :vlax-false
				     )
			      )
			     )
			   )
			  )
			)
			(vla-put-layer Obj2 (nth Ct2 xLayer))
			(cond
			  ((nth Ct2 xIsClipped)
			   (setq Clip	    (nth Ct2 xIsClipped)
				 ClipLength (length Clip)
				 ClipCount  0
			   )
			   (cond
			     ((= ClipLength 2)
			      (setq Clip1 (nth 0 Clip)
				    Clip2 (nth 1 Clip)
				    Clip  (list	Clip1
						(list (car Clip2)
						      (cadr Clip1)
						      (caddr Clip1)
						)
						Clip2
						(list (car Clip1)
						      (cadr Clip2)
						      (caddr Clip2)
						)
					  )
			      )
			     )
			   )
			   (setq Clip (x2a_MakePline xLayout Clip))
			   (cond
			     ((/= (vla-get-closed Clip) T)
			      (vla-put-closed Clip T)
			     )
			   )
			   (vl-cmdf "._xclip"
				    (vlax-vla-object->ename Obj2)
				    ""
				    "_N"
				    "_S"
				    (entlast)
			   )
			   (vla-delete Clip)
			  )
			)
		     )
		   )
		    -1
		  )
		 )
	       )
	      )
	    )
	  )
	)
	 -1
       )
       (command	"._-layer"
		"a"
		"restore"
		(strcat "X2A-" (rtos LS 2 0))
		""
		""
       )
       (command	"._-layer"
		"a"
		"delete"
		(strcat "X2A-" (rtos LS 2 0))
		""
		""
       )
      )
    )
  )
  (vla-put-activelayout *ACAD_DOC* cLayout)
  (if allReactors
    (mapcar 'vlr-add allReactors)
  )					; Restores Reactors
  (vla-EndUndoMark *ACAD_DOC*)
  (princ)
)
Advertisements

About AutoCAD Tips

This blog serves as a knowledge base for myself (and anyone else) so that I can reference tips & tricks that I have learned and also refer others to it as well. I hope that this blog helps you learn at least one tip to make your drafting/design experience better.
This entry was posted in AutoLISP, AutoLISP XREFs, AutoLISP: Modify, XREFs. Bookmark the permalink.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s