Redéfinir des blocs en masse

Facilo · le 31 août 2015

Bonjour a tous et plus particulièrement à Patrick_35.

Je souhaite redéfinir des blocs en masse pour des fichiers du répertoire courant du dessin ouvert.

Patrick_35 j'ai réutilisé ton lisp PAT.lsp mais je bloque sur la mise à jour des fichiers du répertoire courant autre que le dessin courant ouvert. J'utilise la commande _-insert mais cela fonctionne que sur le dessin courant. Peut-être serait-il plus facile d'utiliser vla-InsertBlock mais la je cale.

je livre le contenu (les commentaires sont de moi):

;;;---------------------------------------------------------------
 ;;;
 ;;; Routine principale.
 ;;; Patrick_35
 ;;;---------------------------------------------------------------

  (vl-load-com)
 (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
 (setq Old_Error *error* *error* *errmat* doc (vla-get-activedocument (vlax-get-acad-object)))
   (progn
     ;;;---vlax
     (vlax-for bl (vla-get-blocks doc)
(or (wcmatch (vla-get-name bl) "`**,*|*")
  (eq (vla-get-isxref bl) :vlax-true)
  (setq liste_bl (cons (vla-get-name bl) liste_bl))
)
     )
             ;;;---liste des modèles
 (if (setq dir (folderbox "" "" 1)
           files (vl-directory-files dir "*.dwg" 1)
     )
                   (progn
                     ;;;---travail dessin courrant
	      (progn
		(princ (strcat "\n Travail sur " (getvar "dwgname") " (dessin courant)"))(princ)
			  (foreach f files
       (if (tblsearch "block" (setq b (vl-filename-base f)))
         (progn
           (command "_-insert" (strcat b "=" dir "\\" f))(princ)
           (command)
           (command "_.attsync" "_n" B)
         )
       )
     )
		(princ " ...OK")(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))
		)
                       ;;;---for each liste du repertoire
		(foreach fic lst
		  (setq modif nil)
		  (if (setq doc (ouvrir_dessin_dbx (strcat rep "/" fic)))
                           ;;;---travail liste du repertoire
		    (progn
		      (princ (strcat "\n Travail sur " fic))(princ)
		    	  (foreach f files
       (if (tblsearch "block" (setq b (vl-filename-base f)))
         (progn
; ************************************C'EST ICI QUE CA CELA NE FONCTIONNE PAS
           (command "_-insert" (strcat b "=" dir "\\" f))(princ)
           (command)
           (command "_.attsync" "_n" B)
         )
       )
     )

		      (if modif
			(if (car doc)
			  (princ " ...déjà chargé, REGEN nécessaire si vous l'activez pour voir les modifications.")
			  (progn
			    (princ " ...sauvegarde")(princ)
			    (vla-saveas (car doc) (strcat rep "/" fic))
			    (princ " ...OK")
			  )
			)
			(princ " ...n'a pas été modifié.")
		      )
		      (or (cadr doc)
			(vlax-release-object (car doc))
		      )
		      (princ)
		    )
		  )
		)
	      )
                     
(msgbox "PAT" 64 (strcat "Pas de dessin dans " rep))
	      )
	    )
	  	
(msgbox "PAT" 48 "Pas de liste des modèles")
     )
   )

 (setq *error* Old_Error)
 (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
 (princ)
)
(princ)

Merci d'avance de ta compréhension pour un débutant.

Patrick_35 · le 1 septembre 2015

Salut

Tu ne commences pas par le plus facile en lisp.

Fais déjà un 1er lisp sans utiliser comme base PAT.lsp et qui fonctionne sur le dessin courant

Quelque chose du style

(defun c:redef_blocs(/ blo lst new)
 (setq lst '(bloc1 bloc2 bloc3))			; Liste des blocs à redéfinir
 (foreach blo lst					; Parcourir la liste des blocs (boucle)
   (and (tblsearch "block" blo)			; Test si le bloc existe dans le dessin
 (setq new (findfile (strcat blo ".dwg")))	; Test si on trouve le nouveau bloc
     (progn
(command "_.insert ....)			; Redéfinition du bloc
(entdel (entlast))				; Effacer le dernier objet (logiquement, le bloc inséré)
....						; Faire d'autres commandes ?
     )
   )
 )
)

Et ensuite, tu utilises SuperAutoScript qui appelle le lisp sur une sélection de fichiers.

@+

Facilo · le 12 septembre 2015

Bonjour à tous,

J'ai fait une première ébauche de mon lisp. Par contre je n'arrive pas à filtrer la liste des modèles avec ceux contenus dans chacun des fichiers du répertoire courant. (2ème partie).

Actuellement le lisp ci-dessous, après avoir mis à jour le dessin ouvert, en deuxième partie insert tous les blocs de la liste des modèles dans les dessins. Je pense qu'il manque un focus après l'ouverture des fichiers du répertoire pour exécuter des commandes sur chacun des fichiers ouverts. Mis en ( ;;;==== NE MARCHE PAS ) dans le lisp.

Merci par avance de votre aide.


(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)
      ;;;==== NE MARCHE PAS (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)
)
)
) ;;;===== NE MARCHE PAS)
(princ (strcat "\n...Sauvegarde sur " fic "...ok \n"))(princ)
                        (vla-saveas dbx (strcat rep "\\" fic))
                         (vlax-release-object dbx)
                             ) 
                           ) 
                        )   
                     )
                       )
                     )
 )

Facilo · le 18 septembre 2015

Bonjour, le lisp escompté marche enfin avec mes remerciements pour HMSILVA d'Autodesk community. Le voici en post :

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

Modifié le 29 septembre 2015 par gandhihp

Facilo · le 2 octobre 2016

Bonjour à tous, je voudrais ajouter sur le lisp que je vous joint une commande attsync. Cela marche pour la partie du dessin courant ouvert mais je n'arrive pas à le faire fonctionner sur les autre dessins du repertoire courant. Quelqu'un peut-il me venir en aide.

bien cordialement

;***********************************************************
;***********************************************************
;***************** 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)
;****************************************** Ne marche pas ligne en dessous (mauvaise méthode) !
                                               (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)
                       )
                   )
               )
           )
       )
   )
)

(gile) · le 2 octobre 2016

Salut,

Le LISP utilise ObjectDBX pour ouvrir des dessins "en mémoire", autrement dit, ouvrir la base de données des dessins hors de l'éditeur AutoCAD. Or sans l'éditeur AutoCAD, aucun moyen d'appeler des commandes.

Deux solutions :

- la plus simple : utiliser un script dans un traitement par lot (avec SuperAutoScript par exemple) pour pouvoir utiliser ATTSYNC

- la moins simple : implémenter une fonction LISP qui fait l'équivalent d'ATTSYNC : reconstruction des références d'attributs en fonction des données des définitions d'attributs en conservant leurs valeurs.

Facilo · le 3 octobre 2016

Merci Gile, ta réponse est claire. La première solution est facile. Pour la deuxième il va falloir que je me documente. Merci pour ta réponse rapide

Connexion

Redéfinir des blocs en masse

Messages recommandés

Facilo

Patrick_35

Facilo

Facilo

Facilo

(gile)

Facilo

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante