intersection ligne polyligne et extraction Xdata

[rahim853]

bonjour a tous

je debute en vba , alors je veux faire une macro qui me permet ceci:

j ai un dessin , sur un calque defini, j ai des polylgnes , a chaque polyligne je veux lui attaché un nom d une region(xdata), aprés je fais saisir le une ligne , alors la macro me permetterais de determiner la polyligne (avec son xdata) avec qui la ligne s intersecte.

Y-a-t'il un expert en VBA ou en VB qui à la solution ??

moi j attaque autocad depuit VB6

merci a tous

[(gile)]

Salut et bienvenue,

 

je debute en vba

 

Je ne suis pas sûr que débuter la programmation d'AutoCAD avec VBA soit très judicieux aujourd'hui.

Ce langage va être abandonné par AutoDESK dans les prochaines versions d'AutoCAD.

Ce que tu veux faire est réalisable en LISP. À mon avis, ce langage est vraiment le plus facile pour programmer AutoCAD.

Si tu as des bases en VB et préfères apprendre un langage qui ne soit pas uniquement utilisable dans AutoCAD, regarde du côté dotNET (VB.net ou C#) mais l'apprentissage risque d'être plus long et fastidieux..

[rahim853]

bonjour, j ai deja debuter avec mon programme, je suis en VB et j ai pas le temps en ce moment pour apprendre le lisp

merci pour toute suggestion

[(gile)]

Re,

 

N'étant pas un adepte du VBA, je ne peux que te donner un "pseudo code" et t'indiquer certaines méthodes pour lesquelles tu trouveras plus d'explications dans l'aide aux développeurs d'AutoCAD, ActiveX and VBA Reference.

 

a chaque polyligne je veux lui attaché un nom d une region(xdata)

Là je ne comprends pas bien comment sont sélectionnées les polylignes (traitement automatique ou sélection une par une ?). Dans tous les cas, pour attacher des données étendues, il faut utiliser la méthode SetXdata.

 

aprés je fais saisir le une ligne , alors la macro me permetterais de determiner la polyligne (avec son xdata) avec qui la ligne s intersecte.

- faire saisir une ligne (GetEntity)

- récupérer les points aux extrémités de la ligne (StartPoint et EndPoint)

- faire une sélection "trajet" en utilisant les points et en filtrant les polylignes sur le bon calque (SelectByPolygon acSelectionSetFence)

- contrôler et récupérer les données étendues pour la (ou les) polyligne(s) contenues dans le jeu de sélection (GetXdata)

[rahim853]

merci gile;

j ai pu detourner le probleme en determinat le nom d un block ou se situe un point donné

je vous laisse voir ce que j ai fais

 

 

 

Private Sub essai Click()

'lancer autocad 2008 ou 2009

On Error Resume Next

Set acadApp = GetObject(, "AutoCAD.Application.17")

If Err Then

Err.Clear

Set acadApp = CreateObject("AutoCAD.Application.17")

If Err Then

MsgBox Err.Description

Exit Sub

End If

End If

'ouvrir le ficheir essai se trouvant dans le repertoire de l application

acadApp.Documents.Open (App.Path & "\essai.dwg")

'Rendre l application visible

acadApp.Visible = True

'faire un zoom

acadApp.Application.ZoomAll

 

 

Dim blok As AcadBlockReference

 

' Determination d'un point

Dim Pt1(0 To 2) As Double

Pt1(0) = inputbox("Saisir le X du point")

Pt1(1) = inputbox("Saisir le Y du point")

Pt1(2) = 0

 

' Création d'un rayon horizontal passant par le point

Dim Pt2(0 To 2) As Double

Dim points As Variant

Pt2(0) = Pt1(0) + 1

Pt2(1) = Pt1(1)

Pt2(2) = Pt1(2)

Dim Ray As AcadRay

Set Ray = acadApp.Application.ActiveDocument.ModelSpace.AddRay(Pt1, Pt2)

Dim OBJET As AcadEntity

Dim IntCodeDXF(0) As Integer

Dim ValCodeDXF(0) As Variant

Dim objJeu As AcadSelectionSet

' selection de tous les objet sur le calque

Set objJeu = acadApp.Application.ActiveDocument.SelectionSets.Add("Jaax")

IntCodeDXF(0) = 0: ValCodeDXF(0) = "INSERT"

objJeu.Select acSelectionSetAll

' faire filtrer les objets pour qu il reste seul les blocks

'et faire une boucle pour determiner le nom du block dans lequelle se trouve notre point

For Each OBJET In objJeu

If OBJET.ObjectName = "AcDbBlockReference" Then

Set blok = OBJET

points = blok.IntersectWith(Ray, acExtendNone)

Dim NbrePoints As Integer

NbrePoints = UBound(points) / 3

 

' Détermination en fonction de la parité

If NbrePoints Mod 2 = 0 Then

MsgBox "Le point n'est pas dans le contour" & blok.Name

Else

MsgBox "Le point est dans le contour du" & blok.Name

 

 

End If

End If

Next

Ray.Delete

 

acadApp.Quit

 

End Sub