Insert Multiple blocks into drawing?

[Lee Mac]

Excellent, you're welcome

[EBROWN]

Lee/Alan

I have ran each of your programs and they both insert all the drawing from the folder but they do not redefine the existing blocks that are already on the drawing. I can the program be modified to redefine the blocks when it inserts the drawings.

Thanks

EB

[Lee Mac]

EBROWN said:

Can the program be modified to redefine the blocks when it inserts the drawings.

 

Try this modified version:

 

(defun c:InsertAll ( / dir doc extn spc )

   (setq extn "dwg") ;; Extension of files to Insert e.g "dwg"

   (if (setq dir (LM:DirectoryDialog (strcat "Select Directory of " (strcase extn) " Files to Insert") nil 512))
       (progn
           (setq doc (vla-get-activedocument (vlax-get-acad-object))
                 spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
           )
           (foreach file (vl-directory-files dir (strcat "*." extn) 1)
               (vla-insertblock spc (vlax-3D-point '(0.0 0.0 0.0)) (strcat dir "\\" file) 1.0 1.0 1.0 0.0)
           )
           (vla-regen doc acallviewports)
       )
       (princ "\n*Cancel*")
   )
   (princ)
)

;;-------------------=={ Directory Dialog }==-----------------;;
;;                                                            ;;
;;  Displays a dialog prompting the user to select a folder   ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  msg  - message to display at top of dialog                ;;
;;  dir  - root directory (or nil)                            ;;
;;  flag - bit coded flag specifying dialog display settings  ;;
;;------------------------------------------------------------;;
;;  Returns:  Selected folder filepath, else nil              ;;
;;------------------------------------------------------------;;

(defun LM:DirectoryDialog ( msg dir flag / Shell Fold Self Path )
   (vl-catch-all-apply
       (function
           (lambda ( / ac HWND )
               (if
                   (setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application")
                         HWND  (vl-catch-all-apply 'vla-get-HWND (list ac))
                         Fold  (vlax-invoke-method Shell 'BrowseForFolder (if (vl-catch-all-error-p HWND) 0 HWND) msg flag dir)
                   )
                   (setq Self (vlax-get-property Fold 'Self)
                         Path (vlax-get-property Self 'Path)
                         Path (vl-string-right-trim "\\" (vl-string-translate "/" "\\" Path))
                   )
               )
           )
       )
   )
   (if Self  (vlax-release-object  Self))
   (if Fold  (vlax-release-object  Fold))
   (if Shell (vlax-release-object Shell))
   Path
)

(vl-load-com) (princ)

 

Edited June 1, 2019 by Lee Mac

[EBROWN]

Thanks Lee,

This program did exactly what I asked for.

I created a problem before I ran the program. The existing blocks in the drawing had a text field that had the name of the block.

The block that was inserted had lost it's text field when it was wblock. So the block being inserted has #### instead of the block name.

Can the block text field be add to the block as it is inserted into the drawing.

Thanks,

EB

[Lee Mac]

Your task may require a more specialised program than that posted above which simply inserts each block at the origin without modification. Are the Field Expressions housed in block attributes, or in Text / MText within the block definition itself?

 

Feel free to contact me through my site and I would be happy to look into this further and perhaps develop a dedicated program for the task.

[EBROWN]

Thanks Lee,

 

I'll contact you at your site.

 

BTW the field expression is in mtext

 

EB

[arttopo]

I have two dwg (dwg1 and dwg2). One of the points 1,2,3 ..... other blocks with the same name 1,2,3 .... There can automatically inserting blocks with the same name in dwg2 in dwg1? Sorry for my English.

Thank you.

[danielk]

Did this one but not sure if it would work either.

;;  Block Import Lisp  08/12/2008
;;  CAB at TheSwamp.org

 ;;  Get user selection of folder
 ;;  Get all DWG files in folder
 ;;  INSERT dwg as block @ 0,0
 ;;  get Bounding Box of block
 ;;  Move Insert to right w/ gap between blocks
 ;;  Next Insert

(defun c:BlkImport (/ path LastDist gap space err newblk bname obj ll lr ur
              InsPt dist GetFolder)
 (vl-load-com)
 (defun GetFolder ( / DirPat msg)
  (setq msg "Open a folder and click on SAVE")
  (and
   (setq DirPat (getfiled "Browse for folder" msg " " 1))
   (setq DirPat (substr DirPat 1 (- (strlen DirPat) (strlen msg))))
  )
  DirPat
 )
 

 (defun activespace (doc)
   (if (or (= acmodelspace (vla-get-activespace doc))
           (= :vlax-true (vla-get-mspace doc)))
       (vla-get-modelspace doc)
       (vla-get-paperspace doc)
   )
 )

 (setq gap 20) ; this is the gap between blocks
 (setq LastDist 0.0) ; this is the cumulative distance
 
 (if (setq Path (GetFolder))
   (progn
     (setq space (activespace (vla-get-activeDocument (vlax-get-acad-object))))
     (prompt "\n***  Working, Please wait ......\n")
     (foreach bname (vl-directory-files Path "*.dwg" 1)
       ;;  OK, try & insert the Block
       (if (vl-catch-all-error-p
             (setq err (vl-catch-all-apply
               '(lambda () (setq newblk (vla-insertBlock space 
                               (vlax-3d-point '(0.0 0.0 0.0)) (strcat path bname) 1.0 1.0 1.0 0.0))
                  ))))
         ;;  Display the error message and block/file name
         (prompt (strcat "\n" bname " " (vl-catch-all-error-message err)))
         ;;  ELSE
         (progn ; INSERT was sucessful, move the block
           ;;  get bounding box
           (if (vl-catch-all-error-p
                 (setq err (vl-catch-all-apply 'vla-getboundingbox (list newblk 'll 'ur))))
              (prompt (strcat "\nBB Error - could not move " bname "\n  " (vl-catch-all-error-message err)))
              (progn
                (setq ll (vlax-safearray->list ll)
                      ur (vlax-safearray->list ur)
                      lr (list (car ur) (cadr ll))
                      dist (distance ll lr)
                      )
                ;;  MOVE the block
                (setq ;InsPt  (vla-get-insertionpoint Newblk)
                      NewPt (polar '(0. 0. 0.) 0.0 (+ LastDist Gap (* dist 0.5)))
                      LastDist (+ LastDist Gap dist)
                      )
                (vlax-put Newblk 'insertionpoint NewPt)
              )
           )
         )
        )
     )
   )
 )
 (princ)      
)
(princ)
(prompt "\nBlock Import Loadd, Enter BlkImport to run.")

thanks for that , exactly what i was looking for

[EBROWN]

Can PDF's be added to the code that would insert multiple PDF files?

[Lee Mac]

Hi EBROWN,

 

Try the following:

(defun c:insertall ( / d )
   (if (setq d (LM:browseforfolder (strcat "Select directory of PDF files to insert") nil 512))
       (foreach x (vl-directory-files d "*.pdf" 1)
           (vl-cmdf "_.-attach" (strcat d "\\" x) "" "_non" '(0.0 0.0) 1.0 0.0)
       )
   )
   (princ)
)

;; Browse for Folder  -  Lee Mac
;; Displays a dialog prompting the user to select a folder.
;; msg - [str] message to display at top of dialog
;; dir - [str] [optional] root directory (or nil)
;; flg - [int] bit-coded flag specifying dialog display settings
;; Returns: [str] Selected folder filepath, else nil.

(defun LM:browseforfolder ( msg dir flg / err fld pth shl slf )
   (setq err
       (vl-catch-all-apply
           (function
               (lambda ( / app hwd )
                   (if (setq app (vlax-get-acad-object)
                             shl (vla-getinterfaceobject app "shell.application")
                             hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
                             fld (vlax-invoke-method shl 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) msg flg dir)
                       )
                       (setq slf (vlax-get-property fld 'self)
                             pth (vlax-get-property slf 'path)
                             pth (vl-string-right-trim "\\" (vl-string-translate "/" "\\" pth))
                       )
                   )
               )
           )
       )
   )
   (if slf (vlax-release-object slf))
   (if fld (vlax-release-object fld))
   (if shl (vlax-release-object shl))
   (if (vl-catch-all-error-p err)
       (prompt (vl-catch-all-error-message err))
       pth
   )
)
(vl-load-com) (princ)

 

Edited June 1, 2019 by Lee Mac

[EBROWN]

Thank you Lee. The code performed as expected.

[Lee Mac]

Excellent

[Oasis1]

Hey Everyone,

 

I was running this LISP code to bring in many different dwg's, what I found was happening was that the first image in the file would be on top of the rest when I brought all the drawings into a single dwg. So best way of describing this image 1 appears fine, image 2 is a combination of 1 and 2, image 3 is a combination of 1 and 3...etc till the EOF. This code almost works, I am on Autocad 2014, not sure why it is doing this. When the program is ran, I notice it comes up with "Duplicate Blocks" and is skipping the change.

 

Any help would be greatly appreciated, thanks ahead of time

[Lee Mac]

the first image in the file would be on top of the rest when I brought all the drawings into a single dwg.

 

...image 1 appears fine, image 2 is a combination of 1 and 2, image 3 is a combination of 1 and 3...etc till the EOF.

 

Assuming you are using the posted code to insert the drawings as blocks in another drawing, it sounds as though your first drawing is defined as a block in your second.

 

Therefore, when the second drawing is inserted as a block, the block components use the existing block definition of the first drawing.

 

This would also explain why you are receiving messages stating 'duplicate block definition ignored', indicating that the definition imported with the second drawing is ignored, as it already exists in the parent drawing in the form of the first block (drawing) that is inserted.

[pmadhwal7]

On 9/11/2012 at 5:30 PM, Lee Mac said:

 

Try this modified version:

 

(defun c:InsertAll ( / dir doc extn spc )

   (setq extn "dwg") ;; Extension of files to Insert e.g "dwg"

   (if (setq dir (LM:DirectoryDialog (strcat "Select Directory of " (strcase extn) " Files to Insert") nil 512))
       (progn
           (setq doc (vla-get-activedocument (vlax-get-acad-object))
                 spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
           )
           (foreach file (vl-directory-files dir (strcat "*." extn) 1)
               (vla-insertblock spc (vlax-3D-point '(0.0 0.0 0.0)) (strcat dir "\\" file) 1.0 1.0 1.0 0.0)
           )
           (vla-regen doc acallviewports)
       )
       (princ "\n*Cancel*")
   )
   (princ)
)

;;-------------------=={ Directory Dialog }==-----------------;;
;;                                                            ;;
;;  Displays a dialog prompting the user to select a folder   ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  msg  - message to display at top of dialog                ;;
;;  dir  - root directory (or nil)                            ;;
;;  flag - bit coded flag specifying dialog display settings  ;;
;;------------------------------------------------------------;;
;;  Returns:  Selected folder filepath, else nil              ;;
;;------------------------------------------------------------;;

(defun LM:DirectoryDialog ( msg dir flag / Shell Fold Self Path )
   (vl-catch-all-apply
       (function
           (lambda ( / ac HWND )
               (if
                   (setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application")
                         HWND  (vl-catch-all-apply 'vla-get-HWND (list ac))
                         Fold  (vlax-invoke-method Shell 'BrowseForFolder (if (vl-catch-all-error-p HWND) 0 HWND) msg flag dir)
                   )
                   (setq Self (vlax-get-property Fold 'Self)
                         Path (vlax-get-property Self 'Path)
                         Path (vl-string-right-trim "\\" (vl-string-translate "/" "\\" Path))
                   )
               )
           )
       )
   )
   (if Self  (vlax-release-object  Self))
   (if Fold  (vlax-release-object  Fold))
   (if Shell (vlax-release-object Shell))
   Path
)

(vl-load-com) (princ)

 

THANKS SIR I AM SEARCHING THE SAME AND FOUND YOUR CODE MANY THANKS....