Listing

[fabdo]

Bonjour à tous

 

Existe t-il une routine VBA qui me donnerai le numéro de point X, Y, la cote entre 2 points et la surface finale sous forme d'un listing (sous microstation)

 

Merci..

 

 

[didier]

bonjour,

 

j'ai fais quelque chose dans l'esprit, mais i :

 

j'utilise des polylignes

mes sommets ne sont pas numérotés

je n'ai pas la distance des côtés.

 

c'est facile à compléter mais souhaites-tu

utiliser des polylignes ?

ou cliquer des points ?

comment les sommets sont numérotés ?

 

amicalement

[fabdo]

Bonjour didier

 

J' utilise aussi des polylignes, je numérote volontairement mes sommets car je dois fournir dans mon listing un numéro correspondant à un sommet. Comme je débute dans microstation pour l'instant j'associe une cellule puis un texte pour le matricule et ils sont indépendant l'un de l'aute.

Pas comme dans Autocad ou je pouvais créer des blocs topos pour les points.

J'aimerai donc pouvoir cliquer sur une polyligne ou plutôt sur une "smartligne" et obtenir un listing sous forme de tableau de coordonnées avec en plus le matricule des points créer et la distance des cotés et enfin la surface.

 

Possible ou pas ?

 

Merci.

 

 

 

[didier]

hello,

 

je lâche pas l'affaire,

mais je manque un peu de temps...

 

je travaille dessus

 

 

amicalement

 

[didier]

coucou

 

ben je retrouve plus ce que j'avais fait

donc je retape vite fait un petit truc

j'ai mis un séparateur "point virgule"

pour Excel mais on peut faire mieux avec un peu plus de temps...

 

Sub SurfacesPoly()

Dim Surface As Variant

Dim PolyObj As AcadObject

Dim Sommet1(0 To 1) As Double

Dim Sommet2(0 To 1) As Double

Dim DistanceSommet1Sommet2 As Variant

''''''''''''''

nomcomplet = ThisDrawing.Application.ActiveDocument.FullName

lonnomcomplet = Len(nomcomplet)

nomtempo = Left(nomcomplet, lonnomcomplet - 4)

tempo = Left(nomcomplet, lonnomcomplet - 10)

fichier = nomtempo & "-Sommets.txt"

Set fs = CreateObject("Scripting.FileSystemObject")

Set f = fs.OpenTextFile(fichier, 2, -2)

'''''''''''''''

ThisDrawing.Utility.GetEntity PolyObj, p1, "Choix de la Polyligne"

'''''''''''''''

TableauCoord = PolyObj.Coordinates

num = 1

Sommet1(0) = TableauCoord(0)

Sommet1(1) = TableauCoord(1)

f.write num & ";" & Format(Sommet1(0), "###0.000") & ";" & Format(Sommet1(1), "###0.000") & Chr(13) & Chr(10)

For n = 2 To (UBound(TableauCoord) - 1) Step 2

Sommet2(0) = TableauCoord(n)

Sommet2(1) = TableauCoord(n + 1)

num = num + 1

f.write num & ";" & Format(Sommet1(0), "###0.000") & ";" & Format(Sommet1(1), "###0.000") & Chr(13) & Chr(10)

Sommet1(0) = Sommet2(0)

Sommet1(1) = Sommet2(1)

 

Next

If PolyObj.Closed = True Then

Surface = PolyObj.Area

f.write "Surface ;" & Format(Surface, "###0.0") & "m²"

Else

MsgBox " polyligne non close, pas de surface"

End If

 

f.Close

End Sub

 

amicalement

[fabdo]

bonjour didier

 

Manque de temps aussi juste là pour essayer mais dès que possible je le fais.

 

Merci à toi et Bonnes Fêtes de fin d'année!