Import

[capde06]

Bonjour a tous

voici une moulinette qui permet d'importer les style de cote depuis le prototype

 

 

(defun c:importstylecot ( / template f cotlist )

 (setq template "monproto.dwt")
(vl-load-com)
 
 (if (setq f (opendbx (strcat (getenv "TemplatePath") "\\" template)))
   (progn
     (vlax-for l (vla-get-dimstyles f)
       (or
         (wcmatch (vla-get-Name l) "*|*")
         (setq cotlist (cons l cotlist))
       )
     )
     (vlax-invoke f 'CopyObjects cotlist (vla-get-dimstyles (vla-get-ActiveDocument (vlax-get-acad-object))))
     (vlax-release-object f)
   )
 )
 (princ)
)

 

mais je galère a faire la même pour les styles de "lignes repère multiples"

si vous avez une idée ......

[Patrick_35]

Salut

 

Essaye dans

(vla-item (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object))) "ACAD_MLEADERSTYLE")

 

@+

[capde06]

j'y arrive pas.....??

[capde06]

au cas ou je met la fonction pour test

(defun opendbx(dwg / dbx)
; par Patrick_35
 (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))))
 )
 (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list dbx dwg)))
   nil
   dbx
 )
)

[Patrick_35]

Par exemple

 

(defun opendbx(dwg / dbx)
; par Patrick_35
 (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))))
 )
 (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list dbx dwg)))
   nil
   dbx
 )
)

(defun c:test(/ cotlist)
 (vl-load-com)
 (if (setq f (opendbx "c:/divers/dessin1.dwg"))
   (progn
     (vlax-for l (vla-item (vla-get-dictionaries f) "ACAD_MLEADERSTYLE")
       (or
         (wcmatch (vla-get-Name l) "*|*")
         (setq cotlist (cons l cotlist))
       )
     )

     (vlax-invoke f 'CopyObjects cotlist (vla-item (vla-get-dictionaries (vla-get-ActiveDocument (vlax-get-acad-object))) "ACAD_MLEADERSTYLE"))
     (vlax-release-object f)
   )
 )
 (princ)
)

 

ps : il existe une version améliorée pour ObjectDbx (à cause d'autocad 2014)

 

@+

[capde06]

merci patrick

étrangement ce prog marche sur un dwg mais pas avec un dwt.

 

alors que celui que tu avais fait pour importer les calques marche tres bien avec un dwt

ca marche aussi sur toutes les tables, cotation, line, styles de texte, blocs

mais les reperes multiples, y veut pas

[Patrick_35]

C'est surprenant.

 

Pour tester, j'ai renommé le dwg en dwt et le lisp fonctionne.

Mais pour aller au bout, j'ai fait un nouveau dessin en se servant du dwt (ex dwg) comme gabarit et ça marche aussi.

 

@+

[PHILPHIL]

HELLO PATRIC

 

dans ta reponse 5 ton programme permet d'importer des style "ACAD_MLEADERSTYLE"

 

par quoi je remplace ca pour importer des style de cote ?

 

merci

 

a+

 

phil

[(gile)]

Salut,

 

Les styles de ligne de repère multiple sont enregistrés dans un dictionnaire ("ACAD_MLEADERSTYLE"), les styles de cote dans la table des styles de cote.

 

Le LISP gc:ImportTableRecords ci-dessous permet d'importer tous les enregistrements de la table ou des tables du fichier (dwg ou dwt) spécifié.

 

;;; gc:GetAxDbDoc
;;; Accéder à un dessin fermé.
;;;
;;; Retourne :
;;; Un objet IAxDbDocument si le document est trouvé
;;; nil si le document n'a pu être trouvé ou s'il est ouvert.
;;;
;;; Argument :
;;; filename : le chemin complet du fichier
;;;
;;; Exemple d'utilisation :
;;; (if (setq doc (gc:GetAxDbDoc filename))
;;;   (progn
;;;     ...
;;;     (vlax-release-object doc)
;;;   )
;;; )

(defun gc:GetAxDbDoc (filename / majVer progId AxDbDoc)
 (vl-load-com)
 (setq progId
        (if (< (setq majVer (substr (getvar 'acadver) 1 2)) "16")
          "ObjectDBX.AxDbDocument"
          (strcat "ObjectDBX.AxDbDocument." majVer)
        )
 )
 (if (setq AxDbDoc (vlax-create-object progId))
   (if (vl-catch-all-apply
         'vla-open
         (list AxDbDoc filename)
       )
     (not (vlax-release-object AxDbDoc))
     AxDbDoc
   )
 )
)

;;; gc:ImportTableRecords
;;; Importe tous les enregistrements de la table du fichier spécifié (dwg, dwt) dans le dessin courant
;;;
;;; Retourne :
;;; T si l'opération a réussi, nil sinon
;;;
;;; Arguments :
;;; table    : le nom de la table ou la liste des noms de tables (chaîne ou symbole quoté)
;;;            ("Blocks" "DimStyles" "Layers" "LineTypes" "TextStyles" "UserCoordinateSystems" "Views")
;;; filename : le nom du fichier (chemin complet)
;;;
;;; Exemples d'utilisation :
;;; (gc:ImportTableRecords "Layers" "F:\\AutoCAD Templates\\Building.dwt")
;;; (gc:ImportTableRecords '(Layers DimStyles Textstyles) "F:\\AutoCAD Templates\\Building.dwt")

(defun gc:ImportTableRecords (tables filename / AxDbDoc lst)
 (or (listp tables) (setq tables (list tables)))
 (if (setq AxDbDoc (gc:GetAxDbDoc filename))
   (progn
     (foreach table tables
(setq lst nil)
(vlax-for rec (vlax-get AxDbDoc table)
  (setq lst (cons rec lst))
)
(vlax-invoke
  AxDbDoc
  'CopyObjects
  lst
  (vlax-get (vla-get-ActiveDocument (vlax-get-acad-object)) table)
)
     )
     (or (vlax-release-object AxDbDoc))
   )
 )
)

[(gile)]

Exemple d'utilisation des routines ci-dessus (elle doivent être chargées).

 

La commande IMPORT invite l'utilisateur à choisir les tables à importer puis à spécifier le fichier source dans deux boites dialogue.

 

;;; OptionBox (gile)
;;; Boite de dialogue permettant de choisir une ou plusieurs options
;;;
;;; Arguments
;;; title : le titre de la boite de dialogue (chaîne)
;;; msg ; message (chaîne), "" ou nil por aucun
;;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...)
;;; mult : T (choix multiple) ou nil (choix unique)
;;;
;;; Retour : la clé de l'option (mult = nil) ou la liste des clés des options (mult = T)
;;;
;;; Exemples d'utilisations
;;; (OptionBox "Type de fichier"  nil '(("lin" . "Type de ligne") ("pat" . "Motif de hachure")) nil)
;;; (OptionBox "Types d'entités" "Choisir les types d'entité" '(("LINE" . "Lignes") ("CIRCLE" . "Cercles")) T)

(defun OptionBox (title msg keylab mult / tmp file dcl_id choice)
 (setq	tmp  (vl-filename-mktemp "tmp.dcl")
file (open tmp "w")
 )
 (write-line
   (strcat "OptionBox:dialog{label=\"" title "\";")
   file
 )
 (write-line
   (strcat (if	mult
      ":boxed_column{"
      ":boxed_radio_column{key=\"choice\";"
    )
   )
   file
 )
 (if (and msg (/= msg ""))
   (write-line (strcat "label=\"" msg "\";") file)
 )
 (mapcar
   (function
     (lambda (p)
(write-line
  (strcat (if mult
	    ":toggle{key=\""
	    ":radio_button{key=\""
	  )
	  (car p)
	  "\";label=\""
	  (cdr p)
	  "\";}"
  )
  file
)
     )
   )
   keylab
 )
 (if mult
   (write-line
     "spacer;:button{label=\"Tout sélectionner\";
     key=\"all\";fixed_width=true;alignment=centered;}"
     file
   )
 )
 (write-line "}spacer;ok_cancel;}" file)
 (close file)
 (setq dcl_id (load_dialog tmp))
 (if (not (new_dialog "OptionBox" dcl_id))
   (exit)
 )
 (if mult
   (progn
     (action_tile
"all"
"(foreach k (mapcar 'car keylab)
       (set_tile k\"1\"))"
     )
     (action_tile
"none"
"(foreach k (mapcar 'car keylab)
       (set_tile k\"0\"))"
     )
     (action_tile
"accept"
"(foreach k (mapcar 'car keylab)
       (if (= \"1\" (get_tile k))
       (setq choice (cons k choice))))
       (setq choice (reverse choice))
       (done_dialog)"
     )
   )
   (progn
     (set_tile "choice" (caar keylab))
     (action_tile
"accept"
"(setq choice (get_tile \"choice\")) (done_dialog)"
     )
   )
 )
 (start_dialog)
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 choice
)

;;; Commande IMPORT
;;;Invite l'utilisateur à choisir les tables à importer et le fichier source (boites de dialogue)

(defun C:IMPORT	(/ filename tables)
 (if
   (and
     (setq tables (OptionBox
	     "Import"
	     "Choisir les tables à importer"
	     (mapcar 'cons
		     '("Blocks" "DimStyles" "Layers" "LineTypes" "TextStyles" "UserCoordinateSystems" "Views")
		     '("Blocs" "Styles de cotes" "Calques" "Types de ligne" "Styles de texte" "UCS" "Vues")
	     )
	     T
	   )
     )
     (setq filename (getfiled "Choisir le fichier source" "" "dwg;dwt" 292))
   )
   (if	(gc:ImportTableRecords tables filename)
     (alert "Importation terminée")
     (alert "L'importation a échoué")
   )
 )
 (princ)
)

[PHILPHIL]

hello gile

 

est ce que tu pourrais apporter un modification a ton LISP "IMPORT"

en permettant de selectionner plusieurs fichiers sources

ou meme un repertoire et donc les fichiers *.dwg du repertoire ?

 

bon soirée

 

phil

[(gile)]

Salut,

 

Je n'ai vraiment pas le temps en ce moment, mais si quiconque veut modifier le code, il est "open source".

[Patrick_35]

Salut

 

Tu ajoutes dans le lisp la routine pour sélectionner un répertoire

 (defun dirbox(txt / cdl rep)
   (if (setq cdl (vlax-create-object "Shell.Application"))
     (progn
(and (setq rep (vlax-invoke cdl 'browseforfolder 0 txt 512 ""))
     (setq rep (vlax-get-property (vlax-get-property rep 'self) 'path))
)
(vlax-release-object cdl)
     )
   )
   rep
 )

 

Et tu remplaces le choix du fichier

     (setq filename (getfiled "Choisir le fichier source" "" "dwg;dwt" 292))

 

Par ceci pour traiter tous les fichiers d'un répertoire

     (and (setq rep (dirbox "Choisissez un répertoire pour traiter tous les dessins."))
(foreach filename (append (vl-directory-files rep "*.dwg" 1) (vl-directory-files rep "*.dwt" 1))
  (if (gc:ImportTableRecords tables filename)
    (princ (strcat "\nL'importation du fichier " filename " terminée."))
    (princ (strcat "\nL'importation du fichier " filename " a échoué."))
  )
)
     )

 

Tu supprimes ensuite ceci, qui correspond au traitement d'un fichier (déjà traité auparavant)

   (if (gc:ImportTableRecords tables filename)
     (alert "Importation terminée")
     (alert "L'importation a échoué")
   )

 

ps : non testé

 

@+

[PHILPHIL]

hello patrick

 

j'ai testé, et ca ne fonctionne pas

 

en suivant tes indications, ca me met une erreur dans le lisp en fait, car il n'y a rien a traiter dans le "if"

 

merci de ton aide

 

a+

 

phil

[Patrick_35]

hello patrick

 

j'ai testé, et ca ne fonctionne pas

 

en suivant tes indications, ca me met une erreur dans le lisp en fait, car il n'y a rien a traiter dans le "if"

 

merci de ton aide

 

a+

 

phil

Salut

 

Je l'avais fait vite fait, mais je pensais qu'en cas d'erreur, tu aurais pu corriger.

 

Le lisp corrigé et testé

(defun C:IMPORT	(/ filename tables dirbox rep)

 (defun dirbox(txt / cdl rep)
   (if (setq cdl (vlax-create-object "Shell.Application"))
     (progn
(and (setq rep (vlax-invoke cdl 'browseforfolder 0 txt 512 ""))
     (setq rep (vlax-get-property (vlax-get-property rep 'self) 'path))
)
(vlax-release-object cdl)
     )
   )
   rep
 )

 (and
   (setq tables (OptionBox
	   "Import"
	   "Choisir les tables à importer"
	   (mapcar 'cons
		   '("Blocks" "DimStyles" "Layers" "LineTypes" "TextStyles" "UserCoordinateSystems" "Views")
		   '("Blocs" "Styles de cotes" "Calques" "Types de ligne" "Styles de texte" "UCS" "Vues")
	   )
	   T
	 )
   )
   (setq rep (dirbox "Choisissez un répertoire pour traiter tous les dessins."))
   (foreach filename (append (vl-directory-files rep "*.dwg" 1) (vl-directory-files rep "*.dwt" 1))
     (if (gc:ImportTableRecords tables (strcat rep "/" filename))
(princ (strcat "\nL'importation du fichier " filename " terminée."))
(princ (strcat "\nL'importation du fichier " filename " a échoué."))
     )
   )
 )
 (princ)
)

 

@+

[PHILPHIL]

hello patrick

 

merciiii

 

heu non je suis pas aussi bon que toi en lisp pour tout comprendre

 

j'avais bien bidouillé un peu avant de demander de l'aide, mais ca pas été concluant

 

 

merciii

 

a+

 

phil

[PHILPHIL]

bonjour

 

 

c'est un vieux poste mais bon

 

 

ceci ne marche pas, est ce que le nom du dictionnaire des MLEADER aurait changé depuis ?

 

(gc:importtablerecords "MLEADERSTYLE" "c:\\PERSO\\FICHIER GABARIT\\FICHIER DE BASE.dwt")

(gc:importtablerecords "acad_MLEADERSTYLE" "c:\\PERSO\\FICHIER GABARIT\\FICHIER DE BASE.dwt")

 

 

merci

 

a+

 

Phil

[Fabs]

Bonjours à tous.

Je déterre ce sujet, sur le lisp de Gile complété par Patrick_35.

J’ai ajouté pour mes besoins l’importation des présentations.

(mapcar 'cons

 '("Blocks" "DimStyles" "Layers" "Layouts" "LineTypes" "TextStyles" "UserCoordinateSystems" "Views")

 '("Blocs" "Styles de cotes" "Calques" "Présentations" "Types de ligne" "Styles de texte" "UCS" "Vues")

   )

Ci mes présentations se nomme « présentation1, 2, 3, 4 etc cela fonctionne sauf s’il existe déjà une présentation du même nom (normale).

Si mes présentations se nomment A01, A02, A03 ou tout autre, les présentations son ajouté mes vides, cependant autocad me montre les vignettes pleines.

Quand j’ouvre à nouveau le dwg, il me demande de faire une récupération et me donne ces informations :

Layout Dictionary           Entry BTR doesn't point back Deleted autant que de présentations

Contrôle des entités 1ère passe

Etape 1 1500    objets contrôlés

Contrôle des entités 2ème passe

AcDbBlockTableRecord: "*Paper_Space26"       Not in Table          Added

Etape 2 1300    objets contrôlésAcDbLayout(93E)

Placing A01 in ACAD_LAYOUT dictionary = présentation A01

AcDbLayout(943)

Placing A02 in ACAD_LAYOUT dictionary = présentation A02

AcDbLayout(948)

Etc pour les autres présentations

Etape 2 1500    objets contrôlés

Contrôle des blocs

 27      blocs contrôlés

Contrôle d'AcDsRecords

Nombre total d'erreurs trouvées 129, corrigées 129

0 objets effacés

Pourquoi le lisp c’est lire les présentions normalisées d’autocad mais pas celle que nous nommons.

Je pense que cela vient de « gc:ImportTableRecords » je n’ai pas trouvé la solution

merci par avance si quelqu'un pouvait m'orienter