recuperation des sommets d\'une 3dpoly

[lovecraft]

Bonjour,

je recherche une routine vba pour extraire les sommets d'une 3dpoly et de les transferer sous excel automatiquement.

Pour info: j'ai ce qu'il faut en lisp . Mais j'aimerais ne connaissant pratiquement pas le VBA avoir une p'tit aide.

Merci à tous

 

(defun c:xypoly ()

 

(setq ent (car (entsel "\nCliquez une polyligne :")))

(setq bdent (entget ent))

(setq typent (cdr (assoc 0 bdent)))

(if (= typent "LWPOLYLINE")

(progn

(setq nomfic "C:/XYPOLY2D.txt")

(setq fic (open nomfic "w"))

(setq i 0)

(repeat (length bdent)

(setq entit (nth i bdent))

(setq codeentit (car entit))

(if (= codeentit 10)

(progn

(setq xentit (car (cdr entit)))

(setq yentit (cadr (cdr entit)))

(setq xyentit (strcat (rtos xentit 2 3) " " (rtos yentit 2 3)))

(write-line xyentit fic)

);fin du progn

);fin du if

(setq i (+ i 1))

);fin du repeat

);fin du progn

);fin du if

 

(if (= typent "POLYLINE")

(progn

(setq nomfic "C:/XYPOLY3D.txt")

(setq fic (open nomfic "w"))

(setq i 0)

(setq ent1 (entnext ent))

(setq bdent1 (entget ent1))

(setq typent1 (cdr (assoc 0 bdent1)))

(while (= typent1 "VERTEX")

(setq code10 (cdr (assoc 10 bdent1)))

(setq xentit (car code10))

(setq yentit (cadr code10))

(setq zentit (caddr code10))

(setq xyzentit (strcat (rtos xentit 2 3) " " (rtos yentit 2 3) " " (rtos zentit 2 3)))

(write-line xyzentit fic)

(setq ent1 (entnext ent1))

(setq bdent1 (entget ent1))

(setq typent1 (cdr (assoc 0 bdent1)))

);fin du while

);fin du progn

);fin du if

 

(close fic)

 

);fin du defun c:xypoly

[lovecraft]

bonsoir,

Je ne vous demande pas de faire le programme à ma place.

Mais juste des informations, afin que je puisse réaliser cette routine sous VBA (qqes bouts de codes ;))

Merci à vous.

[Bred]

Salut,

dans l'aide j'ai trouvé ça :

 

Coordinates Example

Sub Example_Coordinates()
   ' This example creates a polyline. [b]It then uses the Coordinates
   ' property to return all the coordinates  in the polyline[/b]. It then
   ' resets one of the vertices using the Coordinates property.
   
   Dim plineObj As AcadPolyline

   ' Create Polyline
   Dim points(5) As Double
   points(0) = 3: points(1) = 7: points(2) = 0
   points(3) = 9: points(4) = 2: points(5) = 0
   Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
   ThisDrawing.Regen True

   ' Return all the coordinates of the polyline
   [b]Dim retCoord As Variant
   retCoord = plineObj.Coordinates[/b]

   ' Display current coordinates for the second vertex
   MsgBox "The current coordinates of the second vertex are: " & points(3) & ", " & points(4) & ", " & points(5), vbInformation, "Coordinates Example"

   ' Modify the coordinate of the second vertex to (5,5,0). Note that in
   ' case of a lightweight Polyline, indices will be different because the points are 2D only.
   points(3) = 5
   points(4) = 5
   points(5) = 0
   plineObj.Coordinates = points

   ' Update display
   ThisDrawing.Regen True

   MsgBox "The new coordinates have been set to " & points(3) & ", " & points(4) & ", " & points(5), vbInformation, "Coordinates Example"
End Sub

 

Donc va voir (dans l'aide) Coordinates property

 

[Edité le 29/3/2007 par Bred]

[lovecraft]

merci de ton aide bred.

en fait ce que je veux faire c'est:

je selectionne un ligne 3d sous autocad

apres definir les nombres de sommets => tableau array

ensuite extraire les coordonnées de la ligne3d.

 

Merci encore

[Encoretoutpetit]

Salut

 

Si service ça peut te rendre, il y a quelques temps j'ai écrit un truc semblable en vba, mais seulement en 2 dimensions, l'adaptation pour la 3ème dimension ne devrait pas poser trop de souci.

Voici un extrait :

 

[surligneur]Public Sub SélectionIntSablière()

 

On Error Resume Next

ThisDrawing.Utility.GetEntity returnObj, "Sélectionner une polyligne."

 

If returnObj.EntityName <> "AcDbPolyline" Then

MsgBox "Il faut sélectionner une polyligne."

Exit Sub

Else

 

If ChevronTubulaire = True Then

'décalage de 44 mm vers l'int pour position des chevrons

returnObjOffset44 = returnObj.Offset(-44)

'transformation de la variable Variant en variable polyligne

Set returnObjDécalé = returnObjOffset44(0)

retCoord = returnObjDécalé.Coordinates

Else

retCoord = returnObj.Coordinates

End If

 

segment = 0

k = LBound(retCoord)

l = UBound(retCoord)

nbr_of_vertices = ((l - k) \ 2) + 1

 

' Determine the number of segments in the polyline.

If returnObj.Closed Then

nbr_of_segments = nbr_of_vertices

Else

nbr_of_segments = nbr_of_vertices - 1

End If

 

MsgBox "La polyligne sélectionnée est composée de " & nbr_of_segments & " segments."

 

'suppression de la polyligne décalée

returnObjDécalé.Delete

 

End If

 

End Sub [/surligneur]

 

Dans les déclarations, j'avais mis ça :

 

[surligneur]Dim returnObj As AcadObject

Dim returnObjOffset44 As Variant 'pour tubulaire

Dim returnObjDécalé As AcadObject 'pour tubulaire

Dim retCoord As Variant

Dim k, l As Integer

Dim nbr_of_segments As Long

Dim nbr_of_vertices As Long

Dim segment As Long [/surligneur]

 

En espérant ne pas être trop hors sujet (ce ne serait pas la première fois !!!)

 

[Encoretoutpetit]

Oup's

 

Désolé pour le jaune les gars, j'ai fait gourance !!!

Moi qui aime bien la discrétion !!!

[lovecraft]

je vous remercie pour votre aide. je suis entrain de finaliser ma routine vba. Je la mettrai a disposition pour ce que ca interresse.

la routine effectuera la fonction suivante extraction des coordonnées d'une polyligne 3d vers excel.

@plus