Inserting Multiple Blocks AND Redefine

[Bill_Myron]

I am attempting to update a numerous amount of blocks in an older drawing. Doing this one at a time is time consuming. I have done some research and found a few LSP that do insert multiple blocks, BUT they seem to not redefine the block definition.

 

Here is the code that I have that I think works well except for the redefining:

(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.")

 

 

Anybody know how to change the code to redefine?

 

Thanks!

[irneb]

This is a pain which I absolutely hate about ACad. Even BricsCAD asks if you want to redefine nested blocks as well - so all you need do there is insert one DWG into another and answer Yes when asked.

 

To get around this I made something a while back, see post #12: http://forums.augi.com/showthread.php?t=74579

[Bill_Myron]

Is there anyway you can make that lisp run without the use of DOSlib? I cannot install programs on the work computer. IT doesnt trust me haha!

 

I have also figured out a code that works for what I am trying to do. I just the folder that contains all my blocks to the support folder path, and then run this lsp:

 

(command "-insert" "a=a" "0,0" "1" "" "0")

 

The only thing is, I had to write the line for every block that we have (120). But now that it is done, seems to work for now. Just have to make sure "Expert" is set to 2 or higher. or else you will have the redefine dialog come up.

 

Instead of doing this, it would be much more simple to select a directory that it reads from and then inserts all the blocks in that directory.

[gilsoto13]

Yep... I guess you will need to make your list of blocks first... and then run the routine on all the drawings you need.

 

Here is another option for your list (not mine though)

 

(defun c:REDEF () 
 (setq ss (ssget "_X" '((0 . "INSERT"))))
 (setq idx (sslength ss)) 
 (while (>= (setq idx (1- idx)) 0) 
   (setq blknm (cdr (assoc 2 (entget(ssname ss idx)))))
   (command "-insert" (strcat blknm "=C:/RYBKA_BLOCKS/BLOCKS/" blknm)) 
   (command) 
 ) 
 (PRINC) 
)

 

I am attempting to update a numerous amount of blocks in an older drawing. Doing this one at a time is time consuming. I have done some research and found a few LSP that do insert multiple blocks, BUT they seem to not redefine the block definition.

 

Here is the code that I have that I think works well except for the redefining:

(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.")

 

 

Anybody know how to change the code to redefine?

 

Thanks!

[dbroada]

Is there anyway you can make that lisp run without the use of DOSlib? I cannot install programs on the work computer. IT doesnt trust me haha!

 

I have also figured out a code that works for what I am trying to do. I just the folder that contains all my blocks to the support folder path, and then run this lsp:

 

(command "-insert" "a=a" "0,0" "1" "" "0")

 

The only thing is, I had to write the line for every block that we have (120). But now that it is done, seems to work for now. Just have to make sure "Expert" is set to 2 or higher. or else you will have the redefine dialog come up.

 

Instead of doing this, it would be much more simple to select a directory that it reads from and then inserts all the blocks in that directory.

for something as simple as that we used to go to DOS and get a listing of all the dwg files sent to a text file (dir *.dwg /b > list.txt). Open that in excel and add a column for each "command" and finally save the file as a .scr script file. When in AutoCAD you can open that file which will run it as a script.

[Bill_Myron]

So after hours of fudging around, I have found a lsp that will insert blocks and redefine them.

 

The only thing is, the program brings up a dialog to search for a directory.

 

I would like to hard code the directory in. is there any way to do this?

 

(defun c:IB2 (/ ocmd DirPath DwgList DiaRtn tmpList tmpName)
(setq ocmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(if
(and
 (setq DirPath (Directory-Dia "Select directory of drawing files/"))
 (setq DwgList (vl-directory-files DirPath "*.dwg" 1))
 (setq DwgList (vl-sort DwgList '(lambda (a b) (< (strcase a) (strcase b)))))
 (setq DiaRtn (MultiSelect DwgList "Select toggle to add all." T))
 (if (/= (car DiaRtn) T)
  (progn
   (foreach Num DiaRtn
    (setq tmpList (cons (nth Num DwgList) tmpList))
   )
   (setq DwgList tmpList)
  )
  T
 )
)
(foreach BlkName DwgList
 (if (tblsearch "Block" (setq tmpName (vl-filename-base BlkName)))
  (progn
   (command "_.insert" (strcat tmpName "=" DirPath BlkName))
   (command)
  )
  (progn
   (command "_.insert" (strcat DirPath BlkName))
   (command)
  )
 )
)
)
(princ)
(setvar "cmdecho" ocmd)
)
;--------------------------------------------------------------------------------------
(defun Directory-Dia ( Message / sh folder folderobject result)
;; By Tony Tanzillo
;; Modified by Tim Willey
 (vl-load-com)
 (setq sh
    (vla-getInterfaceObject
       (vlax-get-acad-object)
       "Shell.Application"
    )
 )

 (setq folder
    (vlax-invoke-method
        sh
        'BrowseForFolder
        (vla-get-HWND (vlax-get-Acad-Object))
        Message
        0
     )
 )
 (vlax-release-object sh)

 (if folder
    (progn
       (setq folderobject
          (vlax-get-property folder 'Self)
       )
       (setq result
          (vlax-get-property FolderObject 'Path)
       )
       (vlax-release-object folder)
       (vlax-release-object FolderObject)
       (if (/= (substr result (strlen result)) "\\")
         (setq result (strcat result "\\"))
         result
       )
    )
 )
)
;--------------------------------------------------------------------------
(defun MultiSelect (Listof Message Toggle / DiaLoad tmpStr tmpTog tmpList)
(setq DiaLoad (load_dialog "MyDialogs.dcl"))
(if (new_dialog "MultiSelect" DiaLOad)
(progn
 (start_list "listbox" 3)
 (mapcar 'add_list Listof)
 (end_list)
 (if Message
  (set_tile "text1" Message)
 )
 (if (not Toggle)
  (mode_tile "toggle1" 1)
 )
 (mode_tile "listbox" 2)
 (action_tile "accept"
  "(progn
   (setq tmpStr (get_tile \"listbox\"))
   (if Toggle
    (setq tmpTog (get_tile \"toggle1\"))
   )
   (done_dialog 1)
  )"
 )
 (action_tile "cancel" "(done_dialog 0)")
 (if (= (start_dialog) 1)
  (progn
   (setq tmpList (read (strcat "(" tmpStr ")")))
   (if (= tmpTog "1")
    (cons T tmpList)
    tmpList
   )
  )
 )
)
)
)