redefine mass blocks

Anonymous · ‎09-17-2015

Hello everyone,
I made a first draft of my lisp. By cons I can not filter the list of models with the elements in each of the current directory files. (Part 2).
Currently the lisp below, having updated the open drawing, second insert portion all blocks of the list of models in drawings. I think it lacks a focus after the opening of the files in the directory to execute commands on each of the open files. Set (;;; ==== DOESNT WORKS) in the lisp.
Thank you in advance for your help.

(vl-load-com)

(defun folderbox1 (message / sh folder result)
    (setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application"))
    (setq folder (vlax-invoke-method sh 'browseforfolder 0 message 0))
    (vlax-release-object sh)
    (if folder
      (progn (setq result (vlax-get-property (vlax-get-property folder 'self) 'path))
             (if (wcmatch result "*\\")
               result
               (strcat result "\\")
             )
      )
    )
  )

  

(defun Ouvrir_dessin_dbx1 (dwg / dbx)
(if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
(setq dbx (vlax-create-object "ObjectDBX.AxDbDocument"))
(setq dbx (vlax-create-object (strcat "ObjectDBX.AxDbDocument." (substr (getvar "ACADVER") 1 2))))
)
(vla-open dbx dwg)
dbx
)

 


(defun c:test ( / dir files f b )
;;;---diallogbx
  (if (setq dir (folderbox1 "Selectionner un dossier avec des gabarits")
            files (vl-directory-files dir "*.dwg" 1)
      )

    (progn
      (foreach f files 
       (if (tblsearch "block" (vl-filename-base f))
(progn
(setq fichier (strcat dir "\\" f))
(setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))


(setq mspace2 (vla-get-modelspace thisdrawing))



(setq obj2 (vla-InsertBlock
mspace2
(vlax-3d-point '(0 0 0))
fichier
1
1
1
0
))
;(tblsearch "block" (setq b (vl-filename-base f)))
(vla-delete obj2)
)))
(princ (strcat "\n...Dessin courant...ok (!) actualiser avec regen"  "\n"))(princ)
))
;;; (2ème partie)
                    ;;;---liste des dessins du repertoire
                    (setq rep (substr (getvar "dwgprefix") 1 (1- (strlen (getvar "dwgprefix")))))

                    (if (setq lst (vl-directory-files rep "*.dwg" 1))
                      (progn
                        (and (eq (strcase rep) (strcase (substr (getvar "dwgprefix") 1 (1- (strlen (getvar "dwgprefix"))))))
                          (setq lst (vl-remove (getvar "dwgname") lst))
                        )
(progn
                     ;;;---for each liste du dossier courant
                        (foreach fic lst
                               (princ (strcat "\n...Ouverture sur " fic "...ok \n"))(princ)
                         (if (setq dbx (ouvrir_dessin_dbx1 (strcat rep "\\" fic)))
                            (progn
                             ;;;---for each du dossier des modèles choisis
                             (foreach f (vl-directory-files dir "*.dwg" 0)
       ;;;==== DOESNT WORKS (if (tblsearch "block" (vl-filename-base f))
(progn                       

                                      (setq fichier1 (strcat dir f))
        
(progn
(setq sp1 (vla-get-ModelSpace dbx))

(setq obj1 (vla-InsertBlock
sp1
(vlax-3d-point '(0 0 0))
fichier1
1
1
1
0
))
(vla-delete obj1)
)
)
 ) ;;;===== DOESNT WORKS)
(princ (strcat "\n...Sauvegarde sur " fic "...ok \n"))(princ)
                         (vla-saveas dbx (strcat rep "\\" fic))
                          (vlax-release-object dbx)
                              ) 
                            ) 
                         )   
                      )
                        )
                      )
  )

hmsilva · ‎09-17-2015

Hi hpinchon,

using ObjectDBX, we have to use ActiveX method, try

(if (setq dbx (ouvrir_dessin_dbx1 (strcat rep "\\" fic)))
   (progn
;;;---for each du dossier des modèles choisis
      (foreach f (vl-directory-files dir "*.dwg" 0)
;;;==== DOESNT WORKS (if (tblsearch "block" (vl-filename-base f))
         (vlax-for blk (vla-get-blocks dbx)
            (if (and (= (vla-get-isxref blk) :vlax-false)
                     (= (vla-get-islayout blk) :vlax-false)
                     (= (vla-get-name blk) (vl-filename-base f))
                )
               (progn

Hope this helps,
Henrique

Anonymous · ‎09-18-2015

Hi hmsilva,

You have the good answer. The lisp work as well? see below and post for community. Thanks a lot.

;***********************************************************
;***********************************************************
;***************** TEST ************************************

(vl-load-com)

(defun folderbox1 (message / sh folder result)
    (setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application"))
    (setq folder (vlax-invoke-method sh 'browseforfolder 0 message 0))
    (vlax-release-object sh)
    (if	folder
      (progn (setq result (vlax-get-property (vlax-get-property folder 'self) 'path))
	     (if (wcmatch result "*\\")
	       result
	       (strcat result "\\")
	     )
      )
    )
  )

  

(defun Ouvrir_dessin_dbx1 (dwg / dbx)
(if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
(setq dbx (vlax-create-object "ObjectDBX.AxDbDocument"))
(setq dbx (vlax-create-object (strcat "ObjectDBX.AxDbDocument." (substr (getvar "ACADVER") 1 2))))
)
(vla-open dbx dwg)
dbx
)

 


(defun c:test ( / dir files f b )
;;;---diallogbx
  (if (setq dir (folderbox1 "Selectionner un dossier avec des gabarits")
            files (vl-directory-files dir "*.dwg" 1)
      )

    (progn
      (foreach f files 
       (if (tblsearch "block" (setq b (vl-filename-base f)))
(progn
(setq fichier2 (strcat dir "\\" f))
(setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))


(setq mspace2 (vla-get-modelspace thisdrawing))



(setq obj2 (vla-InsertBlock
mspace2
(vlax-3d-point '(0 0 0))
fichier2
1
1
1
0
))
(vla-delete obj2)
)))
(princ (strcat "\n...Dessin courant...ok (!) actualiser avec regen"  "\n"))(princ)
))
                    ;;;---liste des dessins du repertoire
                    (setq rep (substr (getvar "dwgprefix") 1 (1- (strlen (getvar "dwgprefix")))))

                    (if (setq lst (vl-directory-files rep "*.dwg" 1))
                      (progn
                        (and (eq (strcase rep) (strcase (substr (getvar "dwgprefix") 1 (1- (strlen (getvar "dwgprefix"))))))
                          (setq lst (vl-remove (getvar "dwgname") lst))
                        )
(progn
                     ;;;---for each liste du dossier courant
                        (foreach fic lst
                          
                               (princ (strcat "\n...Ouverture sur " fic "...ok \n"))(princ)
(if (setq dbx (ouvrir_dessin_dbx1 (strcat rep "\\" fic)))
   (progn
;;;---for each du dossier des modèles choisis
      (foreach f (vl-directory-files dir "*.dwg" 0)
         (vlax-for blk (vla-get-blocks dbx)
            (if (and (= (vla-get-isxref blk) :vlax-false)
                     (= (vla-get-islayout blk) :vlax-false)
                     (= (vla-get-name blk) (vl-filename-base f))
                )
(progn
                                      (setq fichier1 (strcat dir f))
        
(progn
(setq sp1 (vla-get-ModelSpace dbx))

(setq obj1 (vla-InsertBlock
sp1
(vlax-3d-point '(0 0 0))
fichier1
1
1
1
0
))
(vla-delete obj1)
)
)
 )))
(princ (strcat "\n...Sauvegarde sur " fic "...ok \n"))(princ)
                         (vla-saveas dbx (strcat rep "\\" fic))
                          (vlax-release-object dbx)
                              ) 
                            ) 
                         )   
                      )
                        )
                      )
  )

hmsilva · ‎09-18-2015

You're welcome, hpinchon
Glad that works out for you!

Henrique

Anonymous · ‎10-02-2016

Hello everyone, I would add the lisp that I joined you attsync order. This works for part of the current open drawing but I can not get it to work on other drawings of the current directory. Can someone help me.
Best regards

;***********************************************************
;***********************************************************
;***************** C:TEST **********************************
(vl-load-com)

(defun folderbox1 (message / sh folder result)
(setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application"))
(setq folder (vlax-invoke-method sh 'browseforfolder 0 message 0))
(vlax-release-object sh)
    (if folder
        (progn (setq result (vlax-get-property (vlax-get-property folder 'self) 'path))
            (if (wcmatch result "*\\")
            result
            (strcat result "\\")
            )
        )
    )
)


(defun Ouvrir_dessin_dbx1 (dwg / dbx)
    (if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
        (setq dbx (vlax-create-object "ObjectDBX.AxDbDocument"))
        (setq dbx (vlax-create-object (strcat "ObjectDBX.AxDbDocument." (substr (getvar "ACADVER") 1 2))))
    )
(vla-open dbx dwg)dbx
)



(defun c:test ( / dir files f b )
;;;---diallogbx
(if (setq dir (folderbox1 "Selectionner un dossier avec des gabarits")
            files (vl-directory-files dir "*.dwg" 1)
    )
    (progn
        (foreach f files 
            (if (tblsearch "block" (setq b (vl-filename-base f)))
                (progn
                    (setq fichier2 (strcat dir "\\" f))
                    (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
                    (setq mspace2 (vla-get-modelspace thisdrawing))
                    (setq obj2 (vla-InsertBlock mspace2 (vlax-3d-point '(0 0 0)) fichier2 1 1 1 0))
                (vla-delete obj2)
                  (command "_.attsync" "n"  b )
                )
            )
        )
(princ (strcat "\n...Dessin courant...ok (!) actualiser avec regen"  "\n"))(princ)
    )
)
;;;---liste des dessins du repertoire
    (setq rep (substr (getvar "dwgprefix") 1 (1- (strlen (getvar "dwgprefix")))))
    (if (setq lst (vl-directory-files rep "*.dwg" 1))
      (progn
        (and (eq (strcase rep) (strcase (substr (getvar "dwgprefix") 1 (1- (strlen (getvar "dwgprefix"))))))
          (setq lst (vl-remove (getvar "dwgname") lst))
        )
            (progn
     ;;;---for each liste du dossier courant
                (foreach fic lst
                 (princ (strcat "\n...Ouverture sur " fic "...ok \n"))(princ)
                    (if (setq dbx (ouvrir_dessin_dbx1 (strcat rep "\\" fic)))
                         (progn
                         ;;;---for each du dossier des modèles choisis
                            (foreach f (vl-directory-files dir "*.dwg" 0)
                                (vlax-for blk (vla-get-blocks dbx)
                                    (if (and (= (vla-get-isxref blk) :vlax-false)
                                         (= (vla-get-islayout blk) :vlax-false)
                                        (= (vla-get-name blk) (vl-filename-base f))
                                         )
                                        (progn
                                            (setq fichier1 (strcat dir f))
                                            (progn
                                                (setq sp1 (vla-get-ModelSpace dbx))
                                                (setq obj1 (vla-InsertBlock sp1 (vlax-3d-point '(0 0 0)) fichier1 1 1 1 0))
                                                (vla-delete obj1)
 ;****************************************** does not work line below
                                                (command "_.attsync" "n"   (setq b (vl-filename-base f)))
                                           )
                                        )
                                    )
                                )
                            )
                         (princ (strcat "...Sauvegarde sur " fic "...ok \n"))(princ)
                         (vla-saveas dbx (strcat rep "\\" fic))
                         (vlax-release-object dbx)
                        )
                    )
                )
            )
        )
    )
)

Anonymous · ‎01-07-2019

This works for 90% but some blocks it fails to update/redefine properly.

My fixed block is created all on Layer 0 with Color/Linetype Bylayer. However, when I insert/define the block the text doesn't update and assume the layer color properties like it should. Snap17 is results of using the routine, Snap18 is the results of inserting from scratch in blank drawing. Not sure why this would happen this way.

Community

redefine mass blocks

redefine mass blocks

redefine mass blocks