Aller au contenu

Redéfinir des blocs en masse


Facilo

Messages recommandés

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.

Lien vers le commentaire
Partager sur d’autres sites

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.

 

@+

Les Lisps de Patrick

Le but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.

Joseph Joubert, 1754-1824

Lien vers le commentaire
Partager sur d’autres sites

  • 2 semaines après...

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

Lien vers le commentaire
Partager sur d’autres sites

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é par gandhihp
Lien vers le commentaire
Partager sur d’autres sites

  • 1 an après...

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

Lien vers le commentaire
Partager sur d’autres sites

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.

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité