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

Aller au contenu

Page 1 sur 1
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

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

#1 L'utilisateur est hors-ligne   sechanbask 

  • ceinture noire 2em dan
  • Groupe : Membres
  • Messages : 1 016
  • Inscrit(e) : 06-octobre 06
  • LocationPoitiers

Posté 07 septembre 2007 - 23:04

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]
ATEGIE - Bureau d'Études Fluides
Image IPB
Exécution, Synthèse, Conception, Maîtrise d'Oeuvre, Audit, Chiffrage
www.ategie.fr
0

#2 L'utilisateur est hors-ligne   sechanbask 

  • ceinture noire 2em dan
  • Groupe : Membres
  • Messages : 1 016
  • Inscrit(e) : 06-octobre 06
  • LocationPoitiers

Posté 08 septembre 2007 - 19:49

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.
ATEGIE - Bureau d'Études Fluides
Image IPB
Exécution, Synthèse, Conception, Maîtrise d'Oeuvre, Audit, Chiffrage
www.ategie.fr
0

#3 L'utilisateur est hors-ligne   lili2006 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 12 295
  • Inscrit(e) : 21-décembre 05

Posté 09 septembre 2007 - 14:08

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]
0

#4 L'utilisateur est hors-ligne   juh0026 

  • ceinture orange
  • Groupe : Membres
  • Messages : 22
  • Inscrit(e) : 02-août 07

Posté 03 février 2014 - 15:34

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

Partager ce sujet :


Page 1 sur 1
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

1 utilisateur(s) en train de lire ce sujet
0 membre(s), 1 invité(s), 0 utilisateur(s) anonyme(s)