Sur la programmation VBA en autocad
cs_safyou
Messages postés
2
Date d'inscription
mercredi 28 septembre 2005
Statut
Membre
Dernière intervention
4 décembre 2005
-
12 oct. 2005 à 19:35
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:54
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:54
A voir également:
- Sur la programmation VBA en autocad
- Doevents vba - Conseils pratiques -Visual Basic / VB.NET
- Byval vba - Conseils pratiques -Visual Basic / VB.NET
- Commentaire en vba ✓ - Forum ASP / ASP.NET
- Set vba - Forum Visual Basic
- Aide vba - Conseils pratiques -Visual Basic / VB.NET
2 réponses
Pyromar
Messages postés
10
Date d'inscription
dimanche 21 novembre 2010
Statut
Membre
Dernière intervention
18 décembre 2009
31 mai 2007 à 20:34
31 mai 2007 à 20:34
salut
en fait ce que tu demande exige qu'on sache le type d'objet qui represente la trappe , si c'est un cercle c'est evident sinon tu dois nous dire quel type???
en fait ce que tu demande exige qu'on sache le type d'objet qui represente la trappe , si c'est un cercle c'est evident sinon tu dois nous dire quel type???
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:54
29 nov. 2007 à 09:54
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
