VBA- AUTOCAD
cs_nimois30
Messages postés
1
Date d'inscription
jeudi 18 mars 2004
Statut
Membre
Dernière intervention
5 mars 2005
-
5 mars 2005 à 11:46
sowarona Messages postés 4 Date d'inscription mercredi 23 août 2006 Statut Membre Dernière intervention 29 novembre 2007 - 29 nov. 2007 à 09:55
sowarona Messages postés 4 Date d'inscription mercredi 23 août 2006 Statut Membre Dernière intervention 29 novembre 2007 - 29 nov. 2007 à 09:55
2 réponses
cqui789
Messages postés
261
Date d'inscription
jeudi 13 janvier 2005
Statut
Membre
Dernière intervention
18 mai 2009
3
5 mars 2005 à 16:21
5 mars 2005 à 16:21
Si les barres de menu dont tu parles sont dans Excel, allors utilise l'enregistreur de macro pour voir ce qu'il code
en esperant te mettre sur une bonne voie
en esperant te mettre sur une bonne voie
sowarona
Messages postés
4
Date d'inscription
mercredi 23 août 2006
Statut
Membre
Dernière intervention
29 novembre 2007
29 nov. 2007 à 09:55
29 nov. 2007 à 09:55
je voudrais récuperer dans un fichier texte les lignes d'un fchier autocad avec ses caractéristiques ( coordonnées point de départ et point d'arrivée)
j'ai fait le code suivant ca ne marche pas. lobjectif est de génerer le fichier d'échande du logiciel EPANET. En considérant les noeuds comme des blocs c'est ok mais le problème qui persiste concerne les lignes .
de l'aide SVP.
Private Sub CommandButton1_Click()
Dim NomFichierText As String<?xml:namespace prefix o ns "urn:schemas-microsoft-com:office:office" /??>
Dim NomFichier As String
Dim FichAccess As String
FichAccess = ThisDrawing.FullName
' Pour être sûr que ce n'est pas un dessin sans nom
If FichAccess <> "" Then
' on retire l'extension dwg à la fin du nom
FichAccess = Left$(FichAccess, Len(FichAccess) - 4)
' on ajoute l'extension pour Access
Else
FichAccess = "SansNom" ' si le dessin n'a pas encore de nom
End If
'FichAccess = Left$(FichAccess, Len(FichAccess) - 4)
NomFichier = FichAccess
NomFichierText = NomFichier & ".txt"
Open NomFichierText For Output As #1
'Unload Me
'============================================
Dim TL(1 To 100000, 1 To 12) As Variant
Dim k As Long
k = 1
Dim NombreTL As Long
Dim CompteurTL As Long
Dim objElem2 As AcadEntity
For Each objElem2 In ThisDrawing.ModelSpace
' si l'élément est un bloc
If objElem2.EntityType = acdbLine Then
If k <9 Then ComplementNom "N00"
If k >= 10 And k <= 99 Then ComplementNom = "N0"
If k > 100 And j <999 Then ComplementNom "N"
If k > 1000 Then ComplementNom = "N"
objElem2.Highlight (True)
TL(k, 1) = k
TL(k, 2) = objElem2.ObjectName
TL(k, 3) = objElem2.Angle
TL(k, 4) = objElem2.Layer
TL(k, 5) = objElem2.StartPoint(0)
TL(k, 6) = objElem2.StartPoint(1)
TL(k, 7) = objElem2.StartPoint(2)
TL(k, 8) = objElem2.EndPoint(0)
TL(k, 9) = objElem2.EndPoint(1)
TL(k, 10) = objElem2.EndPoint(2)
TL(k, 11) = objElem2.Length
TL(k, 12) = objElem2.ObjectName & ComplementNom & k
TL(k, 13) = objElem2.Delta
TL(k, 14) = objElem2.Length
TL(k, 15) = objElem2.TrueColor
Print #1, TL(k, 1), TL(k, 2), TL(k, 3), TL(k, 4), TL(k, 5), TL(k, 6), TL(k, 7), TL(k, 8), TL(k, 9), TL(k, 10), TL(k, 11), TL(k, 12), TL(k, 12), TL(k, 13), TL(k, 14)
Print #1, ""
k = 1 + k
entry.Highlight (False)
End If
Next objElem2
NombreTL = k
Close #1
End Sub
j'ai fait le code suivant ca ne marche pas. lobjectif est de génerer le fichier d'échande du logiciel EPANET. En considérant les noeuds comme des blocs c'est ok mais le problème qui persiste concerne les lignes .
de l'aide SVP.
Private Sub CommandButton1_Click()
Dim NomFichierText As String<?xml:namespace prefix o ns "urn:schemas-microsoft-com:office:office" /??>
Dim NomFichier As String
Dim FichAccess As String
FichAccess = ThisDrawing.FullName
' Pour être sûr que ce n'est pas un dessin sans nom
If FichAccess <> "" Then
' on retire l'extension dwg à la fin du nom
FichAccess = Left$(FichAccess, Len(FichAccess) - 4)
' on ajoute l'extension pour Access
Else
FichAccess = "SansNom" ' si le dessin n'a pas encore de nom
End If
'FichAccess = Left$(FichAccess, Len(FichAccess) - 4)
NomFichier = FichAccess
NomFichierText = NomFichier & ".txt"
Open NomFichierText For Output As #1
'Unload Me
'============================================
Dim TL(1 To 100000, 1 To 12) As Variant
Dim k As Long
k = 1
Dim NombreTL As Long
Dim CompteurTL As Long
Dim objElem2 As AcadEntity
For Each objElem2 In ThisDrawing.ModelSpace
' si l'élément est un bloc
If objElem2.EntityType = acdbLine Then
If k <9 Then ComplementNom "N00"
If k >= 10 And k <= 99 Then ComplementNom = "N0"
If k > 100 And j <999 Then ComplementNom "N"
If k > 1000 Then ComplementNom = "N"
objElem2.Highlight (True)
TL(k, 1) = k
TL(k, 2) = objElem2.ObjectName
TL(k, 3) = objElem2.Angle
TL(k, 4) = objElem2.Layer
TL(k, 5) = objElem2.StartPoint(0)
TL(k, 6) = objElem2.StartPoint(1)
TL(k, 7) = objElem2.StartPoint(2)
TL(k, 8) = objElem2.EndPoint(0)
TL(k, 9) = objElem2.EndPoint(1)
TL(k, 10) = objElem2.EndPoint(2)
TL(k, 11) = objElem2.Length
TL(k, 12) = objElem2.ObjectName & ComplementNom & k
TL(k, 13) = objElem2.Delta
TL(k, 14) = objElem2.Length
TL(k, 15) = objElem2.TrueColor
Print #1, TL(k, 1), TL(k, 2), TL(k, 3), TL(k, 4), TL(k, 5), TL(k, 6), TL(k, 7), TL(k, 8), TL(k, 9), TL(k, 10), TL(k, 11), TL(k, 12), TL(k, 12), TL(k, 13), TL(k, 14)
Print #1, ""
k = 1 + k
entry.Highlight (False)
End If
Next objElem2
NombreTL = k
Close #1
End Sub
