TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: cmwade77 on December 02, 2011, 05:39:17 PM

Title: Xref Tool Modifications
Post by: cmwade77 on December 02, 2011, 05:39:17 PM
Ok, I am confused, I get the error ActiveX Server returned the error: unknown name: IsXRef with this code. Does anyone have any ideas on how to fix it?

Code: [Select]
;*****************************************************************************************************************
; Xref to Attach/Overlay **
; Written by: Chris Wade **
;   **
;     Version 2.1   **
; 12/XX/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. **
;   - Will only process XRefs within the space that you are currently in. **
;                                           **
;*****************************************************************************************************************
(defun C:x2a ()
(xmethodflip "a")
)
(defun C:x2o ()
(xmethodflip "o")
)
(defun xmethodflip (mode / *ACAD_DOC* *PaperSpace* *ModelSpace* *PaperSpaceID* *ModelSpaceID* *Active* *ActiveID* 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*)
  *PaperSpaceID* (vla-get-objectid *PaperSpace*)
  *ModelSpaceID* (vla-get-objectid *ModelSpace*)
)
;Supporting Functions
(defun x2a_NotNested (name / SS filter)
(setq Filter (list (cons 2 name) (cons 410 (getvar "ctab")))
  ss (ssget "_X" (list filter))
)
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 LS 1)
(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)) "" "" "")
(setq SS (ssget "_X" (list '(0 . "INSERT") (cons 410 (getvar "ctab")))))
((lambda (i / Ent)
(while (setq Ent (ssname SS (setq i (1+ i))))
(setq xObj2 (vlax-ename->vla-object Ent))
(cond
((= (vla-get-isxref xObj2) :vlax-true)
(setq xRname (vla-get-name xObj)
    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 xObj)
((Lambda (I2 / Ent2)
(While (Setq Ent2 (Ssname Ss (Setq I2 (1+ I2))))
(setq Obj (vlax-ename->vla-object Ent2))
(cond
((= (vla-get-isxref Obj) :vlax-true)
((= (vla-get-name Obj) xRname)
(ssdel Ent2 SS)
)
)
)
)
)
-1)
((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-EndUndoMark *ACAD_DOC*)
(princ)
)
Title: Re: Determine if an Insert is an Xref
Post by: cmwade77 on December 02, 2011, 06:23:23 PM
Never mind, I figured that part out, now for the rest of it.
Title: Re: Xref Tool Modifications
Post by: cmwade77 on December 02, 2011, 07:07:44 PM
Ok, so now, I have a couple of issues left, one it will error out if there are no Xrefs on the current tab and two, it will only process xRefs on the current tab, I have tried a few things to cycle through the tabs, but have not been succesful so far, if anyone has any ideas, please let me know.

Here is the new code:
Code: [Select]
;*****************************************************************************************************************
; Xref to Attach/Overlay **
; Written by: Chris Wade **
;   **
;     Version 2.1   **
; 12/02/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. **
;   - Will only process XRefs within the space that you are currently in. **
;                                           **
;*****************************************************************************************************************
(defun C:x2a ()
(xmethodflip "a")
)
(defun C:x2o ()
(xmethodflip "o")
)
(defun xmethodflip (mode / *ACAD_DOC* *PaperSpace* *ModelSpace* *Active* *ActiveID* 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 LS 1)
(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)) "" "" "")
(setq SS (ssget "_X" (list '(0 . "INSERT") (cons 410 (getvar "ctab")))))
((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 (vla-get-blocks *ACAD_DOC*) (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-EndUndoMark *ACAD_DOC*)
(princ)
)
Title: Re: Xref Tool Modifications
Post by: cmwade77 on December 06, 2011, 01:44:04 PM
I got this figured out and I have posted the code in Show Your Stuff, at http://www.theswamp.org/index.php?topic=39024.0
Title: Re: Xref Tool Modifications
Post by: jbuzbee on December 06, 2011, 03:24:02 PM
glad we could help!!  :lmao:
Title: Re: Xref Tool Modifications
Post by: alanjt on December 06, 2011, 03:34:22 PM
glad we could help!!  :lmao:
job well done.
Title: Re: Xref Tool Modifications
Post by: cmwade77 on December 06, 2011, 04:30:58 PM
glad we could help!!  :lmao:
Actually, a lot of figuring it out was thanks to old posts on other forums by members of this board (i.e. figuring out how to do the layouts part, etc.) and figuring out what their code did and then how to make mine do what I needed it to, so you guys were more help than you might know.

But really, I have managed to learn a lot in this process, which is always a good thing.