Incrementation

[jacobs33]

Bonjour et Au secour,

 

J'ai un début de routine qui me permet d'incrémenter les calques de fichiers qui ce trouve dans un répertoire mais en plus je voudrais t'il incrémente les type de lignes les style de textes , bloc style de cotes.

 

 

Sub Anonymus()
Adresse = "C:\TempAcad\"
   For Each Fichier In CreateObject("Scripting.FileSystemObject").GetFolder(Adresse).Files
       If Right(Fichier, 3) = "dwg" Then
           ThisDrawing.Application.Documents.Open (Fichier)
           On Error Resume Next
           I = 1
           For Each calque In ThisDrawing.Layers
           If calque.Name <> "0" Then
           calque.Name = I
           I = I + 1
           End If
           Next
           ActiveDocument.Save
       ActiveDocument.Close
       End If
       
   Next
End Sub

 

Merci de me Sauver....

[Bred]

Salut,

c'est du vba ton code, pas du lisp.

En quel language voudrais-tu faire ça ?

[jacobs33]

Oui c'est du VBA je me suis trompé de Forum.

 

 

 

[jacobs33]

Voir dans forum VBA même sujet...

[jacobs33]

Bonsoir,

 

la finalités de cette routine est de rendre entre guillemet le contenu du fichier anonyme.

 

afin de rendre non identifiable son auteur du DWG.

 

Mon idée c'est d'incrémenter toute les tables "Layers" "DIMstyle" "Style" block etc.

 

 

 

 

[jacobs33]

Bonjour,

 

J'ai écrit ce bon de code pour renommer la table des bloc.

 

ça fonctionne pas par pas mais cas mais les noms de blocs ne change pas.

 

(defun c:IncrBlock (/ IncreEntier RefBloc Incretexte)
 (vl-load-com)
 (vla-startundomark
   (vla-get-activedocument (vlax-get-acad-object))
 )
 (setq RefBloc (tblnext "block" t))
 (setq IncreEntier 1)
 (while RefBloc
   (setq Incretexte (itoa IncreEntier))
   (if	(assoc 2 RefBloc)
     (setq
RefBloc	(subst (cons 2 Incretexte) (assoc 2 RefBloc) RefBloc)
     )
   )
   (entmod RefBloc)
   (setq IncreEntier (+ IncreEntier 1))
   (setq RefBloc (tblnext "block"))
 )
 (vla-endundomark
   (vla-get-activedocument (vlax-get-acad-object))
 )
 (princ)
)