LISP to attach xref to multiple drawings

September 28, 2022

Oops forgot to include one of my little helper functions... code above updated

September 28, 2022

3 hours ago, rlx said:

I don't have zwcad and never used it so not sure if its compatible with visual lisp. Maybe there lies your problem because this is mainly a forum for AutoCad. But I tested it on my own system (AutoCad2022) and for me it works.

(defun c:RlxOdbxDeleteXref (/ _getfolder dbx_ver app dbxv folder xref-name )
  (vl-load-com)
  (defun _getfolder ( m / sh f r )
    (setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application") f (vlax-invoke-method sh 'browseforfolder 0 m 0))
    (vlax-release-object sh)(if f (progn (setq r (vlax-get-property (vlax-get-property f 'self) 'path))(if (wcmatch r "*\\") r (strcat r "\\")))))
  (defun dbx_ver ( / v)
    (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v)))))
  (defun void (x) (or (not x) (= "" x) (and (eq 'STR (type x)) (not (vl-remove 32 (vl-string->list x))))))
  (setq app (vlax-get-acad-object) dbxv (dbx_ver))
  
  (cond
    ((void (setq xref-name (getstring "\nEnter name of xref you want to detach : ")))
     (princ "\nComputer says no : invalid xref name"))
    ((vl-catch-all-error-p (setq odbx (vl-catch-all-apply 'vla-getinterfaceobject (list app dbxv))))
     (princ "\nObject DBX interface not created!"))
    ((setq folder (_getfolder "Select folder with drawings to delete (ALL) xrefs"))
     (setq xref-name (strcase xref-name))
     (foreach dwg (vl-directory-files folder "*.dwg" 0)
       (setq dwg (strcat folder dwg))
       (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list odbx dwg)))
	 (princ (strcase (strcat "\nError opening: " dwg)))
	 (progn
	   (princ (strcat "\nOpening: " dwg))
	   ;;; seek & destroy (all) xrefs
	   (vlax-for lt (vla-get-layouts odbx)
	     (vlax-for blkobj (vla-get-block lt)
	       (if (and
		     (eq (vla-get-objectname blkobj) "AcDbBlockReference")
		     (vlax-property-available-p blkobj 'Path)
		     (eq xref-name (strcase (vl-filename-base (vla-get-name blkobj)) t))
		   )
		 
		 (vlax-invoke-method blkobj 'Delete)
               )
             )
           )
	   ; save drawing
	   (vla-saveas odbx (vla-get-name odbx))
         );end progn
       );end if
       (princ "\nDone")
     ); end foreach
    ); end setq folder
    (t (princ "\nComputer says no"))
  ); end cond
  (vl-catch-all-apply 'vlax-release-object (list app))
  (vl-catch-all-apply 'vlax-release-object (list odbx))
  (princ)
)

thank you so much it's works now.much appreciated your effort for me

November 2, 2022

On 9/28/2022 at 2:33 PM, rlx said:

(defun c:RlxOdbxDeleteXref (/ _getfolder dbx_ver app dbxv folder xref-name )
  (vl-load-com)
  (defun _getfolder ( m / sh f r )
    (setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application") f (vlax-invoke-method sh 'browseforfolder 0 m 0))
    (vlax-release-object sh)(if f (progn (setq r (vlax-get-property (vlax-get-property f 'self) 'path))(if (wcmatch r "*\\") r (strcat r "\\")))))
  (defun dbx_ver ( / v)
    (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v)))))
  (defun void (x) (or (not x) (= "" x) (and (eq 'STR (type x)) (not (vl-remove 32 (vl-string->list x))))))
  (setq app (vlax-get-acad-object) dbxv (dbx_ver))
  
  (cond
    ((void (setq xref-name (getstring "\nEnter name of xref you want to detach : ")))
     (princ "\nComputer says no : invalid xref name"))
    ((vl-catch-all-error-p (setq odbx (vl-catch-all-apply 'vla-getinterfaceobject (list app dbxv))))
     (princ "\nObject DBX interface not created!"))
    ((setq folder (_getfolder "Select folder with drawings to delete (ALL) xrefs"))
     (setq xref-name (strcase xref-name))
     (foreach dwg (vl-directory-files folder "*.dwg" 0)
       (setq dwg (strcat folder dwg))
       (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list odbx dwg)))
	 (princ (strcase (strcat "\nError opening: " dwg)))
	 (progn
	   (princ (strcat "\nOpening: " dwg))
	   ;;; seek & destroy (all) xrefs
	   (vlax-for lt (vla-get-layouts odbx)
	     (vlax-for blkobj (vla-get-block lt)
	       (if (and
		     (eq (vla-get-objectname blkobj) "AcDbBlockReference")
		     (vlax-property-available-p blkobj 'Path)
		     (eq xref-name (strcase (vl-filename-base (vla-get-name blkobj)) t))
		   )
		 
		 (vlax-invoke-method blkobj 'Delete)
               )
             )
           )
	   ; save drawing
	   (vla-saveas odbx (vla-get-name odbx))
         );end progn
       );end if
       (princ "\nDone")
     ); end foreach
    ); end setq folder
    (t (princ "\nComputer says no"))
  ); end cond
  (vl-catch-all-apply 'vlax-release-object (list app))
  (vl-catch-all-apply 'vlax-release-object (list odbx))
  (princ)
)

hi rlx. i already try this code . after i put "name of xref you want to detach". nothing all happen you can see on picture i attach

November 2, 2022

sorry , your picture is to small to see anyting.

November 3, 2022

5 hours ago, rlx said:

sorry , your picture is to small to see anyting.

sorry my mistake . i already reattach with new picture. and the problem is i already try this code . after i put "name of xref you want to detach". nothing all happen you can see on picture i attach

November 3, 2022

(defun c:RlxOdbxDeleteXref (/ _getfolder dbx_ver app dbxv folder xref-name )
  (vl-load-com)
  (defun _getfolder ( m / sh f r )
    (setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application") f (vlax-invoke-method sh 'browseforfolder 0 m 0))
    (vlax-release-object sh)(if f (progn (setq r (vlax-get-property (vlax-get-property f 'self) 'path))(if (wcmatch r "*\\") r (strcat r "\\")))))
  (defun dbx_ver ( / v)
    (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v)))))
  (defun void (x) (or (not x) (= "" x) (and (eq 'STR (type x)) (not (vl-remove 32 (vl-string->list x))))))
  (setq app (vlax-get-acad-object) dbxv (dbx_ver))
  
  (cond
    ((void (setq xref-name (getstring "\nEnter name of xref you want to detach : ")))
     (princ "\nComputer says no : invalid xref name"))
    ((vl-catch-all-error-p (setq odbx (vl-catch-all-apply 'vla-getinterfaceobject (list app dbxv))))
     (princ "\nObject DBX interface not created!"))
    ((setq folder (_getfolder "Select folder with drawings to delete xref"))
     (setq xref-name (strcase xref-name))
     (foreach dwg (vl-directory-files folder "*.dwg" 0)
       (setq dwg (strcat folder dwg))
       (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list odbx dwg)))
	 (princ (strcase (strcat "\nError opening: " dwg)))
	 (progn
	   (princ (strcat "\nOpening: " dwg))
	   (vlax-for lt (vla-get-layouts odbx)
	     (vlax-for blkobj (vla-get-block lt)
	       (if (and
		     (eq (vla-get-objectname blkobj) "AcDbBlockReference")
		     (vlax-property-available-p blkobj 'Path)
		     (eq xref-name (strcase (vl-filename-base (vla-get-name blkobj))))
		   )
		 
		 (vlax-invoke-method blkobj 'Delete)
               )
             )
           )
	   ; save drawing
	   (vla-saveas odbx (vla-get-name odbx))
         );end progn
       );end if
       (princ "\nDone")
     ); end foreach
    ); end setq folder
    (t (princ "\nComputer says no"))
  ); end cond
  (vl-catch-all-apply 'vlax-release-object (list app))
  (vl-catch-all-apply 'vlax-release-object (list odbx))
  (princ)
)

or with some more error checking

(defun c:RlxOdbxDeleteXref (/ _getfolder dbx_ver app dbxv folder xref-name xn err )
  (vl-load-com)
  (defun _getfolder ( m / sh f r )
    (setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application") f (vlax-invoke-method sh 'browseforfolder 0 m 0))
    (vlax-release-object sh)(if f (progn (setq r (vlax-get-property (vlax-get-property f 'self) 'path))(if (wcmatch r "*\\") r (strcat r "\\")))))
  (defun dbx_ver ( / v)
    (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v)))))
  (defun void (x) (or (not x) (= "" x) (and (eq 'STR (type x)) (not (vl-remove 32 (vl-string->list x))))))
  (setq app (vlax-get-acad-object) dbxv (dbx_ver))
  
  (cond
    ((void (setq xref-name (getstring "\nEnter name of xref you want to detach : ")))
     (princ "\nComputer says no : invalid xref name"))
    ((vl-catch-all-error-p (setq odbx (vl-catch-all-apply 'vla-getinterfaceobject (list app dbxv))))
     (princ "\nObject DBX interface not created!"))
    ((setq folder (_getfolder (strcat "Select folder with drawings to delete Xrefs" xref-name)))
     (setq xref-name (strcase xref-name))
     (foreach dwg (vl-directory-files folder "*.dwg" 0)
       (setq dwg (strcat folder dwg))
       (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list odbx dwg)))
	 (princ (strcase (strcat "\nError opening: " dwg)))
	 (progn
	   (princ (strcat "\nOpening: " dwg))
	   (vlax-for lt (vla-get-layouts odbx)
	     (vlax-for blkobj (vla-get-block lt)
	       (if (and (eq (vla-get-objectname blkobj) "AcDbBlockReference") (vlax-property-available-p blkobj 'Path)
			(setq xn (strcase (vl-filename-base (vla-get-name blkobj)))))
		 (cond
		   ((not (eq xref-name xn))
		    (princ (strcat "\n*Names not equal " (vl-princ-to-string xref-name) " /= " (vl-princ-to-string xn))))
		   ((setq err (vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list blkobj))))
		    (princ (strcat "\n*Unable to detach xref " xn " : " (vl-catch-all-error-message err))))
		   (t (princ (strcat "\nSuccesfully detached xref : " xn)))
                 )
               )
	     )
           )
	   ; save drawing
	   (if (setq err (vl-catch-all-error-p (vl-catch-all-apply 'vla-saveas (list odbx (vla-get-name odbx)))))
	     (princ (strcat "\n*Unable to save drawing " (vla-get-name odbx) " : " (vl-catch-all-error-message err)))
	       (princ (strcat "\nSuccesfully saved drawing : " (vla-get-name odbx))))
         );end progn
       );end if
       (princ "\nDone")
     ); end foreach
    ); end setq folder
    (t (princ "\nComputer says no"))
  ); end cond
  (vl-catch-all-apply 'vlax-release-object (list app))
  (vl-catch-all-apply 'vlax-release-object (list odbx))
  (princ)
)

Hope these work better. Think the bug is (was) the strcase function. The xref name you typed in was converted upper case and the name of the scanned xref converted to lower case.

November 7, 2022

On 11/3/2022 at 8:23 PM, rlx said:

(defun c:RlxOdbxDeleteXref (/ _getfolder dbx_ver app dbxv folder xref-name )
  (vl-load-com)
  (defun _getfolder ( m / sh f r )
    (setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application") f (vlax-invoke-method sh 'browseforfolder 0 m 0))
    (vlax-release-object sh)(if f (progn (setq r (vlax-get-property (vlax-get-property f 'self) 'path))(if (wcmatch r "*\\") r (strcat r "\\")))))
  (defun dbx_ver ( / v)
    (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v)))))
  (defun void (x) (or (not x) (= "" x) (and (eq 'STR (type x)) (not (vl-remove 32 (vl-string->list x))))))
  (setq app (vlax-get-acad-object) dbxv (dbx_ver))
  
  (cond
    ((void (setq xref-name (getstring "\nEnter name of xref you want to detach : ")))
     (princ "\nComputer says no : invalid xref name"))
    ((vl-catch-all-error-p (setq odbx (vl-catch-all-apply 'vla-getinterfaceobject (list app dbxv))))
     (princ "\nObject DBX interface not created!"))
    ((setq folder (_getfolder "Select folder with drawings to delete xref"))
     (setq xref-name (strcase xref-name))
     (foreach dwg (vl-directory-files folder "*.dwg" 0)
       (setq dwg (strcat folder dwg))
       (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list odbx dwg)))
	 (princ (strcase (strcat "\nError opening: " dwg)))
	 (progn
	   (princ (strcat "\nOpening: " dwg))
	   (vlax-for lt (vla-get-layouts odbx)
	     (vlax-for blkobj (vla-get-block lt)
	       (if (and
		     (eq (vla-get-objectname blkobj) "AcDbBlockReference")
		     (vlax-property-available-p blkobj 'Path)
		     (eq xref-name (strcase (vl-filename-base (vla-get-name blkobj))))
		   )
		 
		 (vlax-invoke-method blkobj 'Delete)
               )
             )
           )
	   ; save drawing
	   (vla-saveas odbx (vla-get-name odbx))
         );end progn
       );end if
       (princ "\nDone")
     ); end foreach
    ); end setq folder
    (t (princ "\nComputer says no"))
  ); end cond
  (vl-catch-all-apply 'vlax-release-object (list app))
  (vl-catch-all-apply 'vlax-release-object (list odbx))
  (princ)
)

or with some more error checking

(defun c:RlxOdbxDeleteXref (/ _getfolder dbx_ver app dbxv folder xref-name xn err )
  (vl-load-com)
  (defun _getfolder ( m / sh f r )
    (setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application") f (vlax-invoke-method sh 'browseforfolder 0 m 0))
    (vlax-release-object sh)(if f (progn (setq r (vlax-get-property (vlax-get-property f 'self) 'path))(if (wcmatch r "*\\") r (strcat r "\\")))))
  (defun dbx_ver ( / v)
    (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v)))))
  (defun void (x) (or (not x) (= "" x) (and (eq 'STR (type x)) (not (vl-remove 32 (vl-string->list x))))))
  (setq app (vlax-get-acad-object) dbxv (dbx_ver))
  
  (cond
    ((void (setq xref-name (getstring "\nEnter name of xref you want to detach : ")))
     (princ "\nComputer says no : invalid xref name"))
    ((vl-catch-all-error-p (setq odbx (vl-catch-all-apply 'vla-getinterfaceobject (list app dbxv))))
     (princ "\nObject DBX interface not created!"))
    ((setq folder (_getfolder (strcat "Select folder with drawings to delete Xrefs" xref-name)))
     (setq xref-name (strcase xref-name))
     (foreach dwg (vl-directory-files folder "*.dwg" 0)
       (setq dwg (strcat folder dwg))
       (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list odbx dwg)))
	 (princ (strcase (strcat "\nError opening: " dwg)))
	 (progn
	   (princ (strcat "\nOpening: " dwg))
	   (vlax-for lt (vla-get-layouts odbx)
	     (vlax-for blkobj (vla-get-block lt)
	       (if (and (eq (vla-get-objectname blkobj) "AcDbBlockReference") (vlax-property-available-p blkobj 'Path)
			(setq xn (strcase (vl-filename-base (vla-get-name blkobj)))))
		 (cond
		   ((not (eq xref-name xn))
		    (princ (strcat "\n*Names not equal " (vl-princ-to-string xref-name) " /= " (vl-princ-to-string xn))))
		   ((setq err (vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list blkobj))))
		    (princ (strcat "\n*Unable to detach xref " xn " : " (vl-catch-all-error-message err))))
		   (t (princ (strcat "\nSuccesfully detached xref : " xn)))
                 )
               )
	     )
           )
	   ; save drawing
	   (if (setq err (vl-catch-all-error-p (vl-catch-all-apply 'vla-saveas (list odbx (vla-get-name odbx)))))
	     (princ (strcat "\n*Unable to save drawing " (vla-get-name odbx) " : " (vl-catch-all-error-message err)))
	       (princ (strcat "\nSuccesfully saved drawing : " (vla-get-name odbx))))
         );end progn
       );end if
       (princ "\nDone")
     ); end foreach
    ); end setq folder
    (t (princ "\nComputer says no"))
  ); end cond
  (vl-catch-all-apply 'vlax-release-object (list app))
  (vl-catch-all-apply 'vlax-release-object (list odbx))
  (princ)
)

Hope these work better. Think the bug is (was) the strcase function. The xref name you typed in was converted upper case and the name of the scanned xref converted to lower case.

@rlx thank you so much it's works now.much appreciated your effort for me

March 10, 2023

RLX,

I have a question on the way that lisp attach the xref, is there a way to change the option "attach" to "overlay"? and also is possible to select the layer instead to use layer 0? thanks

March 10, 2023

minimal tested

(defun c:RlxOverlayXref (/ _getfolder app adoc odbs odbx v xref folder dwg xr lay)
  (vl-load-com)
  (defun _getfolder ( m / sh f r )
    (setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application") f (vlax-invoke-method sh 'browseforfolder 0 m 0))
    (vlax-release-object sh)(if f (progn (setq r (vlax-get-property (vlax-get-property f 'self) 'path))(if (wcmatch r "*\\") r (strcat r "\\")))))
  ; i is 0 (absolute), 1 (relative) of 2 (no) -xref path
  (defun RLXref_SetPathType (i)
    (vl-registry-write (strcat "HKEY_CURRENT_USER\\" (vlax-product-key) "\\Profiles\\" (getvar "cprofile") "\\Dialogs\\XattachDialog") "PathType" i))
  (setq odbs "ObjectDBX.AxDbDocument" v (substr (getvar 'acadver) 1 2) adoc (vla-get-activedocument (setq app (vlax-get-acad-object))))
  (RLXref_SetPathType 1)
  (cond
    ((vl-catch-all-error-p (setq odbx (vl-catch-all-apply 'vla-getinterfaceobject (list app (if (< (atoi v) 16) odbs (strcat odbs "." v))))))
     (princ "\nObject DBX interface not created!"))
    ((not (setq xref (getfiled "Select Xref to attach" "" "dwg" 0))) (alert "No Xref was selected"))
    ((setq folder (_getfolder "Select folder with drawings to attach xref to"))
     (if (not (setq lay (ask "Enter layer [0]"))) (setq lay "0"))
     (foreach dwg (vl-directory-files folder "*.dwg" 0)
       (setq dwg (strcat folder dwg))
       (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list odbx dwg)))
         (princ (strcase (strcat "\nError opening: " dwg)))
         (progn
           (princ (strcat "\nOpening: " dwg))
           ; overlay xref
           (if (vl-catch-all-error-p (setq xr (vl-catch-all-apply 'vla-AttachExternalReference
                 (list (vla-get-ModelSpace odbx) xref (vl-filename-base xref) (vlax-3d-point 0 0 0) 1 1 1 0 :vlax-true))))
             (princ (vl-catch-all-error-message xr))
             (progn
               (vl-catch-all-apply 'vla-add (list (vla-get-layers odbx) lay))
               (vl-catch-all-apply 'vla-put-layer (list xr lay))
             )
           )
           ; save drawing
           (vla-saveas odbx (vla-get-name odbx))
         )
       )
     )
    );;; end getfolder
    (t (princ "\nAction cancelled"))
  ); end cond
  (princ)
)

; simple dialog for getstring so no switching needed from dialog to command line (ask "How are you?")
(defun ask ( $m / f p d r s) (if (and (setq f (vl-filename-mktemp ".dcl"))(setq p (open f "w")))
  (progn (write-line (strcat "ask :dialog {label =\"" $m "\";:edit_box {key=\"eb\";}spacer;ok_cancel;}") p)(close p)(gc)
    (setq d (load_dialog f))(new_dialog "ask" d) (mapcar '(lambda(x y)(action_tile x y)) '("eb" "accept" "cancel")
      '("(setq s $value)""(done_dialog 1)""(done_dialog 0)"))(setq r (start_dialog))(unload_dialog d)(vl-file-delete f)))
  (if (and (= r 1) (= 'STR (type s)) (/= s "")) s nil)
)

March 13, 2023

Thanks RLX, this lisp work like a charm!

That was exactly what I was looking for.

November 27, 2023

On 2/5/2019 at 10:54 PM, rlx said:

a quicky before breakfast

;;; Attach Xref to all drawings in Folder , RLX 6-Feb-2019
(defun c:RlxFaXref (/ _getfolder app adoc odbs odbx v xref folder dwg xr)
  (vl-load-com)
  (defun _getfolder ( m / sh f r )
    (setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application") f (vlax-invoke-method sh 'browseforfolder 0 m 0))
    (vlax-release-object sh)(if f (progn (setq r (vlax-get-property (vlax-get-property f 'self) 'path))(if (wcmatch r "*\\") r (strcat r "\\")))))
  ; i is 0 (absolute), 1 (relative) of 2 (no) -xref path
  (defun RLXref_SetPathType (i)
    (vl-registry-write (strcat "HKEY_CURRENT_USER\\" (vlax-product-key) "\\Profiles\\" (getvar "cprofile") "\\Dialogs\\XattachDialog") "PathType" i))
  (setq odbs "ObjectDBX.AxDbDocument" v (substr (getvar 'acadver) 1 2) adoc (vla-get-activedocument (setq app (vlax-get-acad-object))))
  (RLXref_SetPathType 1)
  (cond
    ((vl-catch-all-error-p (setq odbx (vl-catch-all-apply 'vla-getinterfaceobject (list app (if (< (atoi v) 16) odbs (strcat odbs "." v))))))
     (princ "\nObject DBX interface not created!"))
    ((not (setq xref (getfiled "Select Xref to attach" "" "dwg" 0))) (alert "No Xref was selected"))
    ((setq folder (_getfolder "Select folder with drawings to attach xref to"))
     (foreach dwg (vl-directory-files folder "*.dwg" 0)
       (setq dwg (strcat folder dwg))
       (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list odbx dwg)))
  (princ (strcase (strcat "\nError opening: " dwg)))
  (progn
    (princ (strcat "\nOpening: " dwg))
    ; attach xref
    (if (vl-catch-all-error-p (setq xr (vl-catch-all-apply 'vla-AttachExternalReference
        (list (vla-get-ModelSpace odbx) xref (vl-filename-base xref) (vlax-3d-point 0 0 0) 1 1 1 0 :vlax-false))))
      (princ (vl-catch-all-error-message xr)))
    ; save drawing
    (vla-saveas odbx (vla-get-name odbx))
  )
       )
     )
    )
  )
  (princ)
)

This sort of worked for me and also sort of didnt. I am green to using LISPs like this so please bare with me. I was able to get my xref into all of my drawing files, however, I had to change the 'attach' selection to 'overlay' as that is how my company wants xrefs done. My biggest issue however was that I wasnt seeing any of my xref linework, the file was there in the manager but nothing was appearing until I right clicked on the xref and selected 'attach' then it would "re-attach" and all the linework popped in. So while I didnt have to path to every file each time I still had to do something in each file to get it to work. any suggestions? I am past this particular project but would love to have a working .lsp for future use cases. Thank you!

November 27, 2023

On 3/10/2023 at 3:15 PM, rlx said:

minimal tested

(defun c:RlxOverlayXref (/ _getfolder app adoc odbs odbx v xref folder dwg xr lay)
  (vl-load-com)
  (defun _getfolder ( m / sh f r )
    (setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application") f (vlax-invoke-method sh 'browseforfolder 0 m 0))
    (vlax-release-object sh)(if f (progn (setq r (vlax-get-property (vlax-get-property f 'self) 'path))(if (wcmatch r "*\\") r (strcat r "\\")))))
  ; i is 0 (absolute), 1 (relative) of 2 (no) -xref path
  (defun RLXref_SetPathType (i)
    (vl-registry-write (strcat "HKEY_CURRENT_USER\\" (vlax-product-key) "\\Profiles\\" (getvar "cprofile") "\\Dialogs\\XattachDialog") "PathType" i))
  (setq odbs "ObjectDBX.AxDbDocument" v (substr (getvar 'acadver) 1 2) adoc (vla-get-activedocument (setq app (vlax-get-acad-object))))
  (RLXref_SetPathType 1)
  (cond
    ((vl-catch-all-error-p (setq odbx (vl-catch-all-apply 'vla-getinterfaceobject (list app (if (< (atoi v) 16) odbs (strcat odbs "." v))))))
     (princ "\nObject DBX interface not created!"))
    ((not (setq xref (getfiled "Select Xref to attach" "" "dwg" 0))) (alert "No Xref was selected"))
    ((setq folder (_getfolder "Select folder with drawings to attach xref to"))
     (if (not (setq lay (ask "Enter layer [0]"))) (setq lay "0"))
     (foreach dwg (vl-directory-files folder "*.dwg" 0)
       (setq dwg (strcat folder dwg))
       (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list odbx dwg)))
         (princ (strcase (strcat "\nError opening: " dwg)))
         (progn
           (princ (strcat "\nOpening: " dwg))
           ; overlay xref
           (if (vl-catch-all-error-p (setq xr (vl-catch-all-apply 'vla-AttachExternalReference
                 (list (vla-get-ModelSpace odbx) xref (vl-filename-base xref) (vlax-3d-point 0 0 0) 1 1 1 0 :vlax-true))))
             (princ (vl-catch-all-error-message xr))
             (progn
               (vl-catch-all-apply 'vla-add (list (vla-get-layers odbx) lay))
               (vl-catch-all-apply 'vla-put-layer (list xr lay))
             )
           )
           ; save drawing
           (vla-saveas odbx (vla-get-name odbx))
         )
       )
     )
    );;; end getfolder
    (t (princ "\nAction cancelled"))
  ); end cond
  (princ)
)

; simple dialog for getstring so no switching needed from dialog to command line (ask "How are you?")
(defun ask ( $m / f p d r s) (if (and (setq f (vl-filename-mktemp ".dcl"))(setq p (open f "w")))
  (progn (write-line (strcat "ask :dialog {label =\"" $m "\";:edit_box {key=\"eb\";}spacer;ok_cancel;}") p)(close p)(gc)
    (setq d (load_dialog f))(new_dialog "ask" d) (mapcar '(lambda(x y)(action_tile x y)) '("eb" "accept" "cancel")
      '("(setq s $value)""(done_dialog 1)""(done_dialog 0)"))(setq r (start_dialog))(unload_dialog d)(vl-file-delete f)))
  (if (and (= r 1) (= 'STR (type s)) (/= s "")) s nil)
)

So this one worked to get the xref to be an 'overlay' attachment type and is on the appropriate layer, but I am still left to go into model space and "re-attach" the xref to get the linework to appear.

November 28, 2023

On 3/10/2023 at 3:15 PM, rlx said:

minimal tested

(defun c:RlxOverlayXref (/ _getfolder app adoc odbs odbx v xref folder dwg xr lay)
  (vl-load-com)
  (defun _getfolder ( m / sh f r )
    (setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application") f (vlax-invoke-method sh 'browseforfolder 0 m 0))
    (vlax-release-object sh)(if f (progn (setq r (vlax-get-property (vlax-get-property f 'self) 'path))(if (wcmatch r "*\\") r (strcat r "\\")))))
  ; i is 0 (absolute), 1 (relative) of 2 (no) -xref path
  (defun RLXref_SetPathType (i)
    (vl-registry-write (strcat "HKEY_CURRENT_USER\\" (vlax-product-key) "\\Profiles\\" (getvar "cprofile") "\\Dialogs\\XattachDialog") "PathType" i))
  (setq odbs "ObjectDBX.AxDbDocument" v (substr (getvar 'acadver) 1 2) adoc (vla-get-activedocument (setq app (vlax-get-acad-object))))
  (RLXref_SetPathType 1)
  (cond
    ((vl-catch-all-error-p (setq odbx (vl-catch-all-apply 'vla-getinterfaceobject (list app (if (< (atoi v) 16) odbs (strcat odbs "." v))))))
     (princ "\nObject DBX interface not created!"))
    ((not (setq xref (getfiled "Select Xref to attach" "" "dwg" 0))) (alert "No Xref was selected"))
    ((setq folder (_getfolder "Select folder with drawings to attach xref to"))
     (if (not (setq lay (ask "Enter layer [0]"))) (setq lay "0"))
     (foreach dwg (vl-directory-files folder "*.dwg" 0)
       (setq dwg (strcat folder dwg))
       (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list odbx dwg)))
         (princ (strcase (strcat "\nError opening: " dwg)))
         (progn
           (princ (strcat "\nOpening: " dwg))
           ; overlay xref
           (if (vl-catch-all-error-p (setq xr (vl-catch-all-apply 'vla-AttachExternalReference
                 (list (vla-get-ModelSpace odbx) xref (vl-filename-base xref) (vlax-3d-point 0 0 0) 1 1 1 0 :vlax-true))))
             (princ (vl-catch-all-error-message xr))
             (progn
               (vl-catch-all-apply 'vla-add (list (vla-get-layers odbx) lay))
               (vl-catch-all-apply 'vla-put-layer (list xr lay))
             )
           )
           ; save drawing
           (vla-saveas odbx (vla-get-name odbx))
         )
       )
     )
    );;; end getfolder
    (t (princ "\nAction cancelled"))
  ); end cond
  (princ)
)

; simple dialog for getstring so no switching needed from dialog to command line (ask "How are you?")
(defun ask ( $m / f p d r s) (if (and (setq f (vl-filename-mktemp ".dcl"))(setq p (open f "w")))
  (progn (write-line (strcat "ask :dialog {label =\"" $m "\";:edit_box {key=\"eb\";}spacer;ok_cancel;}") p)(close p)(gc)
    (setq d (load_dialog f))(new_dialog "ask" d) (mapcar '(lambda(x y)(action_tile x y)) '("eb" "accept" "cancel")
      '("(setq s $value)""(done_dialog 1)""(done_dialog 0)"))(setq r (start_dialog))(unload_dialog d)(vl-file-delete f)))
  (if (and (= r 1) (= 'STR (type s)) (/= s "")) s nil)
)

So this one worked to get the xref to be an 'overlay' attachment type and is on the appropriate layer, but I am still left to go into model space and "re-attach" the xref to get the linework to appear.

**EDIT gosh I feel dumb, I found out what the issue was, this lisp was putting my xref in paperspace. What part of that routine do I need to change to get the xref inserted into model space??

November 28, 2023

On 4/24/2019 at 12:47 PM, rlx said:
haven't looked at this code for a while so just guessing right now but change :
 (list (vla-get-ModelSpace odbx) xref (vl-filename-base xref) (vlax-3d-point 0 0 0) 1 1 1 0 :vlax-false)))) 
to
(list (vla-get-PaperSpace odbx) xref (vl-filename-base xref) (vlax-3d-point 0 0 0) 1 1 1 0 :vlax-false)))) 

I posted above code on first page from this thread to go from model to paper , so I guess change it back? But it really has been a long time I have looked at this code. Haven't done any lisping for a while now so I'm afraid I'm a little out of shape at this moment.

About the missing lines , this routine uses dbx. This means that some changes will only show after you first save & reopen the drawing. Other downside of dbx is loosing thumbnail. That's why I have a button called 'just save' in my own 'script writer' but that's another story.

November 28, 2023

2 hours ago, rlx said:

I posted above code on first page from this thread to go from model to paper , so I guess change it back? But it really has been a long time I have looked at this code. Haven't done any lisping for a while now so I'm afraid I'm a little out of shape at this moment.

About the missing lines , this routine uses dbx. This means that some changes will only show after you first save & reopen the drawing. Other downside of dbx is loosing thumbnail. That's why I have a button called 'just save' in my own 'script writer' but that's another story.

Thanks for the reply! It looks like I am already using the one that is supposed to go into ModelSpace but I am thinking that it just inserted the xref on the layout that was active when it opened the file.

Thanks again for the response, I know this is like 4 years old so just a response is nice lol

Sign In

LISP to attach xref to multiple drawings

Recommended Posts

rlx

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

rlx

rlx

Lee Mac

Posted Images

thajmul

fourxz

rlx

fourxz

rlx

fourxz

FTC-1

rlx

FTC-1

WestParkGuy

WestParkGuy

WestParkGuy

rlx

WestParkGuy

Join the conversation

rlx

rlx

Lee Mac

Tutorials

Forums

Activity