Jump to content

LISP to attach xref to multiple drawings


Pattosun

Recommended Posts

I have 200 DWG's that I need to add the same xreference to and it needs to be Relative Path.

The xref file name is "a3sheet.dwg"

Scale is 1

Insertion is 0,0

 

This is my first time writing a Lisp. I have tried:

 

(defun c:XRA ()

    (command "-xref" "Attach" "a3sheet.dwg" "Scale" "1" "0.0" "0"

    (princ)

)

 

but I'm getting error function cancelled.

Ideally the LISP would load and run when the drawing opens, or even better a batch process of all 200 at once...

Any help would be much appreciated. Thanks Patto

 

 

Link to comment
Share on other sites

You are missing a closing bracket for the command expression - I would suggest:

(defun c:xra ( / dwg )
    (if (setq dwg (findfile "a3sheet.dwg"))
        (command "_.-xref" "_A" dwg "_S" 1 "_R" 0 "_non" '(0 0))
    )
    (princ)
)

As for batch processing, you could look to run the above program across multiple drawing from an AutoCAD Script file (.scr).

 

You may wish to refer to the following resources:

 

An Introduction to Script Writing

Script Writer

Run AutoLISP Program on Batch of Drawings

Batch Processing Explanation

  • Like 1
Link to comment
Share on other sites

10 hours ago, Pattosun said:

I have 200 DWG's that I need to add the same xreference to and it needs to be Relative Path.

The xref file name is "a3sheet.dwg"

Scale is 1

Insertion is 0,0

 

This is my first time writing a Lisp. I have tried:

 

(defun c:XRA ()

    (command "-xref" "Attach" "a3sheet.dwg" "Scale" "1" "0.0" "0"

    (princ)

)

 

but I'm getting error function cancelled.

Ideally the LISP would load and run when the drawing opens, or even better a batch process of all 200 at once...

Any help would be much appreciated. Thanks Patto

 

 

 

Hi Lee, thanks for the reply. When running your suggested Lisp I an getting the message "error to few arguments" in the command line. Any ideas?

Link to comment
Share on other sites

Command has no closing bracket

 

200 dwgs no probs script could be as simple as

 


open dwg1 (c:X-RAY) close y

open dwg2 (c:X-ray) close y

....

ignore xray on iPad spell checker

 

If the dwgs are in one directory about 5 minutes work to make script just know lots of cheats to make.

 

 

 

 

 

 

Link to comment
Share on other sites

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)
)

 

  • Like 1
  • Thanks 1
Link to comment
Share on other sites

Thanks so much for your replies, and great content on your site Lee Mac... I've got it working using a script... I'm a first timer on this so awesome to get something working...

 

_.open "C:\Users\Patto\Documents\Drawings\DWG204H524.dwg" _.xref _D C:\Users\Patto\Documents\Titleblock\a3sheet.dwg _S 1 _R 0 _non 0,0,0 _.Zoom _E _.qsave _.close

_.open "C:\Users\Patto\Documents\Drawings\DWG204H525.dwg" _.xref _D C:\Users\Patto\Documents\Titleblock\a3sheet.dwg _S 1 _R 0 _non 0,0,0 _.Zoom _E _.qsave _.close

_.open "C:\Users\Patto\Documents\Drawings\DWG204H526.dwg" _.xref _D C:\Users\Patto\Documents\Titleblock\a3sheet.dwg _S 1 _R 0 _non 0,0,0 _.Zoom _E _.qsave _.close

 

 

Now I also  want to Create a new text style in each drawing and move all existing text to that style... Here is what I have so far...

 

_.open "C:\Users\Patto\Documents\Drawings\DWG204H524.dwg" _.style AS100 ISO3098b 0 1 0 N N N _.Zoom _E _.qsave _.close

 

This creates the new AS1100 text style but I can't work out what commands to use to select all text and move them to that text style...

AI_SELALL selects everything but I just want to select the MText and Text.

 

Any ideas?

 

Edited by Pattosun
missing so info
Link to comment
Share on other sites

 _.open "C:\Users\Patto\Documents\Drawings\DWG204H524.dwg" (load "chstyle.lsp") (c:chstyle) _.Zoom _E _.qsave _.close


(defun c:ChStyle ( / s i o) (vl-load-com)
  (if (and (not (tblsearch "style" "AS100"))(findfile "ISO3098b.shx"))
    (vl-cmdf "-style" "AS100" "ISO3098b" 0 1 0 "N" "N" "N")
    (if (not (findfile "ISO3098b.shx"))(princ "\nText font ISO3098b.shx not found")))
  (if (and (tblsearch "style" "AS100") (setq s (ssget "x" '((0 . "TEXT,MTEXT")))))
    (repeat (setq i (sslength s))
      (vla-put-stylename (setq o (vlax-ename->vla-object (ssname s (setq i (1- i))))) "AS100")
      (vla-Update o)
    )
    (princ "\nNo (m)text objects were updated")
  )
  (princ)
)

Edited by rlx
Link to comment
Share on other sites

12 hours ago, Pattosun said:

Hi Lee, thanks for the reply. When running your suggested Lisp I an getting the message "error to few arguments" in the command line. Any ideas?

 

Are you sure you copied the code correctly?

Are you viewing this site through a translator which may have mangled the code?

Link to comment
Share on other sites

Thanks so much rlx, that's awesome...... 

It does one dwg at a time, is there a way to get this working as a batch process?

I've tried to use this for multiple drawing using Lee Mac's ScriptWriter:

So APPLOAD

load your lsp

Then load ScriptWriter and use....

_.open *file* (c:ChStyle) _.qsave

 

but this only does the first drawing in the folder, the others are opened but no changes are made?

 

Link to comment
Share on other sites

you have to either load the lisp file every time in the script file (as in example line above my code) or you must make sure this file is auto-loaded every time you open a file , for example with s::startup in your acad.lsp or just add it as a standard routine in your acad.lsp. With a few mod's code can be added to my first code which uses odbx but scripts are more fun to look at even though they are a little bit slower.

Edited by rlx
  • Thanks 1
Link to comment
Share on other sites

I posted this before but you can use find replace to edit scripts adding like rlx code, I normally just start with a dwg names text file. This is created using old fashioned DOS commands dir *.dwg >dwglst.txt

 

Using Word you can change end of line or start of line adding stuff like open, close y it’s ^p for end of line.

  • Thanks 1
Link to comment
Share on other sites

31 minutes ago, Lee Mac said:

 

Are you sure you copied the code correctly?

Are you viewing this site through a translator which may have mangled the code?

 

Hi Lee, I didn't see your message till this morning....

No I'm not using a translator. I think the problem was the folder naming that my client has asked for. They want the xref stored in ..\..\Title Block & Images\a3sheet.dwg

 

Do spaces and characters such as "&" cause a problem with lisp and script?

 

I changed the folder name to  ..\..\Titleblock\a3sheet.dwg and it worked, but my client insists that they will not change their file structure. Is there a way to keep the folder as "Title Block & Images" but still batch process the dwgs?

Link to comment
Share on other sites

Thanks for all your replies everyone, this was a steep learning curve for me, and I still have a long way to go. I have updated my 200 DWGs using the method below. Some of the items below could probably be combined or added to the acad start up lsp if I was more knowledgable, but this is how I got to the end result so thought I would type it out for any other Newbies out there ....

 

How to Xref Detach All, Xref Attach, Make Xref Relative, Create Text Style, Change All Text To This Style :

  1. Load LSP files in AutoCAD
    1. APPLOAD >
      1. Chstyle.lsp (by RLX see below)
      2. Rlxfaxref.lsp (by RLX see below)
      3. ScriptWriterV1-2.lsp (by Lee Mac http://lee-mac.com/scriptwriter.html)
  2. Batch Detach All Old Xref's using Script Writer 
    1. WSCRIPT >
      1. Use script line:  _.open *file* _.xref _D * _.zoom _E _.qsave _.close
      2. Choose drawing directory
  3. Batch Attach New Xref using LSP
    1. RLXRAREF >
      1. Select Xref to attach
      2. Browse to DWG folder
  4. Batch Make Xref Relative using Script Writer 
    1. WSCRIPT >
      1. Use script line:  _.open *file* _.xref _T a3sheet _R _.zoom _E _.qsave _.close
      2. Choose drawing directory
  5. Batch Create New Text Style and Change All Text To This Style
    1. WSCRIPT >
      1. Use script line:  _.open *file* (load”chstyle.lsp”) (c:chstyle) _.zoom _E _.qsave _.close
      2. Choose drawing directory

RLXFAREF.LSP

;;; 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)
)


 

CHSTYLE.LSP

(defun c:ChStyle ( / s i o) (vl-load-com)
  (if (and (not (tblsearch "style" "AS100"))(findfile "ISO3098b.shx"))
    (vl-cmdf "-style" "AS100" "ISO3098b" 0 1 0 "N" "N" "N")
    (if (not (findfile "ISO3098b.shx"))(princ "\nText font ISO3098b.shx not found")))
  (if (and (tblsearch "style" "AS100") (setq s (ssget "x" '((0 . "TEXT,MTEXT")))))
    (repeat (setq i (sslength s))
      (vla-put-stylename (setq o (vlax-ename->vla-object (ssname s (setq i (1- i))))) "AS100")
      (vla-Update o)
    )
    (princ "\nNo (m)text objects were updated")
  )
  (princ)
)

 

Link to comment
Share on other sites

17 hours ago, Pattosun said:

Do spaces and characters such as "&" cause a problem with lisp and script?

 

I changed the folder name to  ..\..\Titleblock\a3sheet.dwg and it worked, but my client insists that they will not change their file structure. Is there a way to keep the folder as "Title Block & Images" but still batch process the dwgs?

 

Spaces and the ampersand character will not cause a problem, but note that the backslash character is an Escape Character in AutoLISP, and hence, a literal backslash is obtained by prefixing the backslash escape character with another backslash to mark it as a literal.

 

As such, the path should be:

"..\\..\\Title Block & Images\\a3sheet.dwg"

 

  • Thanks 1
Link to comment
Share on other sites

  • 2 months later...
On 2/6/2019 at 6:54 AM, 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)
)

 

 

Could you please change code, I need xref to be attached in Paper space not Model. Thank you in advance :)

Link to comment
Share on other sites

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)))) 

 

Link to comment
Share on other sites

; attach xref in paperspace
(defun c:RlxPsXref (/ _getfolder RLXref_SetPathType 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"))
     (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))
             (progn
               (vlax-for lay (vla-get-layouts odbx)
               (if (/= "MODEL" (strcase (vla-get-name lay))) (vlax-invoke odbx 'copyobjects (list xr) (vla-get-block lay))))
               (vla-delete xr)
             )
           )
    ; save drawing
    (vla-saveas odbx (vla-get-name odbx))
  )
       )
     )
    )
  )
  (princ)
)

Link to comment
Share on other sites

  • 2 weeks later...
On 2/6/2019 at 6:54 AM, 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)
)

Hi I am new to the forum and not sure how things work. I am also completely new to coding. But I like the coding, RLX.

However most of my drawings are in the layout tab, for your coding to work I need to be in the model tab. Is it possible to add a switch to the model tab before starting the rest of the code? 

 

 

Link to comment
Share on other sites

Not sure if modelspace tab needs to be active for this routine to work. As you can see in the code before your post, the xref it is inserted in modelspace and then copied to paperspace and the one in modelspace is deleted. But to make make the modelspace active  you would need a script because this routine uses odbx and this has many restrictions and one of them is changing the active layout

 

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/set-layout-current-via-objectdbx/td-p/1233977

 

(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))
             (progn
               (vlax-for lay (vla-get-layouts odbx)
               (if (/= "MODEL" (strcase (vla-get-name lay))) (vlax-invoke odbx 'copyobjects (list xr) (vla-get-block lay))))
               (vla-delete xr)
             )
           )
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...