Blocs dynamiques to blocs statiques depuis VBA EXCEL pour versions pleines et LT

[sechanbask]

MACRO VBA EXCEL

 

VBA n'existe pas sous autocad LT mais il est possible de commander autocad via le VBA d'EXCEL...

 

Voilà le code: version 0.4

[surligneur]

A priori, ça marche pour les versions pleines et LT mais je n'ai pas de retour sur cette version...

Si ça marche merci à ceux qui m'ont aidé et si ça marche pas merci à ceux qui vont m'aider...[/surligneur]

 

Modifications notables :

-ajout de gestion d'erreur si autocad est ouvert sans plan

 

 

Public Graphics As AcadApplication
Sub BlocDynToStaticBloc()
Dim chemin As String
Dim Ent As AcadEntity
Dim C As Integer

'si error continuer par la ligne suivante
On Error Resume Next
'capture l'objet autocad en tant qu'application s'il est ouvert
Set Graphics = GetObject(, "AutoCAD.Application")
'si l'objet n'existe pas, c'est que l'application n'est pas lancée, donc création de l'objet
If Err.Description > vbNullString Then
'effacer le type d'erreur
Err.Clear
'ouvrir l'application autocad
Set Graphics = CreateObject("AutoCAD.Application")
'demande à l'utilisateur quel est le dessin à ouvrir
chemin = Application.GetOpenFilename("Dessins AutoCAD (*.dwg), *.dwg")
'ouvrir le document dans autocad
Graphics.Documents.Open (chemin)

End If

'autocad visible
Graphics.Visible = True
Dim sngNomPlan As Single
sngNomPlan = 0
sngNomPlan = Graphics.Documents.Count

Select Case sngNomPlan
'cest ici qu'on pourra gérer les transormation des blocs sur plusieurs plans...
Case 0
'demande à l'utilisateur quel est le dessin à ouvrir
chemin = Application.GetOpenFilename("Dessins AutoCAD (*.dwg), *.dwg")
'ouvrir le document dans autocad
Graphics.Documents.Open (chemin)

End Select

Dim strNumeroVersion As String
'récuperer le numero de la verion autocad
strNumeroVersion = Graphics.Version
'récuperer uniquement les 4 premiers carcatères en partant de la gauche
strNumeroVersion = Left(strNumeroVersion, 4)
'mettre dans le fenêtre d'execution le numero de la version
Debug.Print strNumeroVersion


'mettre à 0 le nombre de passage de boucle = nombre de bloc dynamique
C = 0

'pour chaque entité dans le dessin ouvert
For Each Ent In Graphics.ActiveDocument.ModelSpace

'bloc?
If Ent.ObjectName = "AcDbBlockReference" Then

Dim handlenom As String
'récuperer le handle du bloc
handlenom = Ent.Handle

'si une erreur survient aller dans la gestion d'erreur
'qui s'appelle gestion (voir la fin du code)
On Error GoTo gestion
' attention s'il ya une entité que l'on ne peut pas considérée
'comme IAcadBlockReference2 ou IAcadBlockReference (version autre que 2006)
'elle est deplacée dans le nouveau calque "Bloc_à_problème"

Dim oBkRef As IAcadBlockReference
'enregistrer l'entité en tant que IAcadBlockReference2

'test sur la verion
Select Case strNumeroVersion

Case 16.2
'la version est 2006
'aller dans la function sautfunction
'pour changer la référence du bloc
'obligatoirement dans une function car si
'on utilise une version 2007,
'VBA lors de la prévérification va trouver une
'déclaration inexacte et va faire une erreur non gérable

sautfunction

Case Else
'si la verion est differente de 2006

Set oBkRef = Ent
'l'entité est enregistrer sous une réference de bloc

End Select

'le bloc est-il dynamique?
If oBkRef.IsDynamicBlock = True Then
'incrementer la variable C
C = 1 + C

Dim v As Variant
'mettre les propriétés dynamiques dans V
v = oBkRef.GetDynamicBlockProperties

Dim P As Integer
'chercher dans les V les propriétés
For P = LBound(v) To UBound(v)

'mettre le nom de la propriété dans odynprop
Dim oDynProp As AcadDynamicBlockReferenceProperty
Set oDynProp = v(P)

'si la propriété est la visibilité
If oDynProp.PropertyName = "Visibilité" Then
Dim Visibilite As String
'mettre dans visibilité l'été de visibilité
Visibilite = oDynProp.Value
End If 'si la propriété est la visibilité
Next P

Dim strNomeff As String
'mettre dasn strnomeff le nom du bloc (qui apparait à l'utilisateur)
'en ajoutant la visibilité et le handle
'permet de recréer plusieurs fois des blocs identiques
'alors que ce n'est pas possible s'il porte le même nom...
'(ça c'est pas terrible car le nombre de bloc va vraiment augmenter mais je ne vois pas comment le gérer)
strNomeff = oBkRef.EffectiveName & " " & Visibilite & " " & handlenom
'convertir le bloc dyn en bloc statique et lui donner son ancien nom + visibilité +son handle
oBkRef.ConvertToStaticBlock (strNomeff)

'si possible remettre l'unite du bloc telle qu'elle était définie

Else 'blocdyn?
End If 'blocdyn?

On Error GoTo 0

End If 'bloc?

Next Ent 'pour chaque entité dans le dessin ouvert

Select Case C
Case 0
MsgBox "Le dessin ne contient pas de bloc dynamique."
Case 1
MsgBox C & " bloc dynamique a été transformé en bloc statique."
Case Else
MsgBox C & " blocs dynamiques ont été transformés en blocs statiques."
End Select

Exit Sub

gestion:
Debug.Print Err.Number, Err.Description

'déplace dans un nouveau calque l'entité "non bloc ref" et pourtant détectée comme telle
Dim Newlayer1 As AcadObject
Dim strNouveaucalque As String
strNouveaucalque = "Bloc_à_problème"
Set Newlayer1 = Graphics.ActiveDocument.Layers.Add(strNouveaucalque)
On Error Resume Next
Ent.Layer = strNouveaucalque
If Err.Number = 91 Then
MsgBox "Veuillez purger les blocs de votre dessin avant de recommencez l'opération."
End If

End Sub

Function sautfunction()

Dim oBkRef2 As IAcadBlockReference2
Set oBkRef2 = Ent
Set oBkRef = oBkRef2


End Function

 

Il faut le mettre dans un module VBA d'excel, ajouter la référence AUTOCAD library (selon la version) (dans Outils référence et faire F5 sous VBA editeur ou revenir sur le feuille EXCEL et faire F8 puis choisir BlocDynToStaticBloc et faire EXECUTER.

 

J'espère que ça marche sous autocad Lt sinon, veuillez m'informer des problèmes (ligne et numéro d'erreur)...[Edité le 7/9/2007 par sechanbask][Edité le 8/9/2007 par sechanbask][Edité le 8/9/2007 par sechanbask][Edité le 10/9/2007 par sechanbask][Edité le 10/9/2007 par sechanbask]

 

[Edité le 13/9/2007 par sechanbask]

[sechanbask]

Pour tout commentaire sur ce sujet, le plus simple c'est de poster sous ce sujet... Merci d'avance de vos remarques et ou de modifications.

[lili2006]

Re,

 

sechanbask

 

Chez moi, ça marche à merveille, rien à redire, si ce n'est chapeau !

 

Merci pour cet outils trés utile et bonne continuation.

 

Au plaisir.

 

Bon Dimanche (Bien nmérité , il me semble,...).

 

[Edité le 9/9/2007 par lili2006]

[juh0026]

Bonjour, je viens de tomber sur ce code, et juste pour dire merci à " sechanbask" car ce code est vraiment super !!!!

Bonne continuation.