gérer la demande d\'automatisation de service

[CabinetD]

Bonour à tous...

 

J'ai fais une petite macro qui sélectionne une polyligne....

Le première fois, tout est ok, mais quand je la relance, AutoCAD me répond :

Erreur d'exécution '-21453209029 (8021001f)

AutoCAD ne peut gérer la demande d'automatisation de service

 

Aucune commande n'est en cours dans AutoCAD et rien n'est sélectionné...

 

Quelqu'un à une idée ?

 

Merci...

[g_barthe]

Bonjour,

Je n'ai jamais eu cette erreur meme en relancant plusieurs fois la meme macro.

 

Par contre n'est ce pas un pb de variable encore en memoire qui pourrait perturber l'exécution la seconde fois ?

 

Du style vider le contenu mémoire une fois l'exécution de la macro finie.

 

Je ne sais pas c'est une idée.

 

Mais en ayant le code de la macro peut etre que ce serait plus simple pour voir les opérations que tu fais sur la polyligne.

 

Je manipule également les polylignes.. mais jamais eu ca.

[CabinetD]

Ok, voici la macro ( je suis en train de la faire, alors la mise en forme n'est pas faite )

 

Public Sub nbPoints()

Dim objPoly As AcadLWPolyline
Dim basePnt As Variant
Dim nbPoints, Pt As Integer
Dim Tableau(200) As String
Dim MtextObj As AcadMText
a = 0: Pt = 1
ThisDrawing.Utility.GetEntity objPoly, basePnt, "Selectionner une polyligne :"

For Each Coordinate In objPoly.Coordinates
 Tableau(nbPoints) = Coordinate
 nbPoints = nbPoints + 1
Next

'MsgBox "Cette polyligne à : " & nbPoints / 2 & " pts(x,y)"
Do While Tableau(a) <> ""
Texte = Texte & "\P" & Pt & "   X=" & Tableau(a) & "   Y=" & Tableau(a + 1)

' Set MtextObj = ThisDrawing.ModelSpace.AddMText([surligneur]**ICI**[/surligneur] , 200, Texte) 


Pt = Pt + 1
a = a + 2
Loop


   Texte = "Tableau des coordonnées\P" + Texte
   
   'Saisie du point d'insertion
   returnPnt = ThisDrawing.Utility.GetPoint(, "Cliquez le coin Haut Gauche du Cadre :")
   'Insert le texte au point d'insertion
   Set MtextObj = ThisDrawing.ModelSpace.AddMText(returnPnt, 200, Texte)
   MtextObj.Height = 3
'    MtextObj.StyleName = "Time"
   MtextObj.Update
End Sub

 

J'aimerai mettre **ICI** les coordonnées du point pour écrire le matricule du point aux sommets de la polyligne

 

 

Merci...

[g_barthe]

Euh je vois pas les coordonnées de quel point tu veux spécifier.

 

Pourrais tu m'expliquer un peu stp ?

 

 

Je suppose que ce n'est pas le point de base de la polyligne.

 

[CabinetD]

C'est qu'à chaque sommet de la polyligne, j'aimerais écrire le numéro du sommet (Pt)

 

Pour faire la relation entre le tableau

1 X=456.65 Y= 132.22

2 X=456.21 Y= 134.22

3 X=451.65 Y= 136.22

4 X=......

5 X=......

 

Et la polyligne

 

Merci encore...

[winfield]

SAlut, je crois que c'est un truc du genre que tu veux

 Dim PtNumTxt(2) As Double
PtNumTxt(0) = Tableau(a): PtNumTxt(1) = Tableau(a + 1)
Set MtextObj = ThisDrawing.ModelSpace.AddMText(PtNumTxt, 200, _
"Pt n°" & Pt & "\PX=" & Format(Tableau(a), "##0.###0") & "\PY=" & Format(Tableau(a + 1), "##0.###0"))

Ce qui donne :

Public Sub nbPoints()

Dim objPoly As AcadLWPolyline
Dim basePnt As Variant
Dim nbPoints, Pt As Integer
Dim Tableau(200) As String
Dim MtextObj As AcadMText
a = 0: Pt = 1
ThisDrawing.Utility.GetEntity objPoly, basePnt, "Selectionner une polyligne :"

For Each Coordinate In objPoly.Coordinates
Tableau(nbPoints) = Coordinate
nbPoints = nbPoints + 1
Next
Do While Tableau(a) <> ""
Texte = Texte & "\P" & Pt & " X=" & Tableau(a) & " Y=" & Tableau(a + 1)  [surligneur]
Dim PtNumTxt(2) As Double
PtNumTxt(0) = Tableau(a): PtNumTxt(1) = Tableau(a + 1)
Set MtextObj = ThisDrawing.ModelSpace.AddMText(PtNumTxt, 200, _
"Pt n°" & Pt & "\PX=" & Format(Tableau(a), "##0.###0") & "\PY=" & Format(Tableau(a + 1), "##0.###0")) [/surligneur]
Pt = Pt + 1
a = a + 2
Loop
Texte = "Tableau des coordonnées\P" + Texte
'Saisie du point d'insertion
returnPnt = ThisDrawing.Utility.GetPoint(, "Cliquez le coin Haut Gauche du Cadre :")
'Insert le texte au point d'insertion
Set MtextObj = ThisDrawing.ModelSpace.AddMText(returnPnt, 200, Texte)
MtextObj.Height = 3
' MtextObj.StyleName = "Time"
MtextObj.Update
End Sub 

 

Bonne continuation