GetPoint

[winfield]

Lors de l'utilisation de GetPoint, on peut cliquer à l'écran ou taper des coordonnées : mais on peut taper une valeur (distance). Quand c'est une distance, le système Getpoint doit certainement évaluer où se trouve la souris.....

Comment faire pour faire un truc du genre sans passer par GetPoint tout en indiquant la direction avec la souris ?

En espérant avoir été clair

[Bred]

Salut,

Désolé, je ne te répondrais pas car je ne sais pas.... :P

 

....Mais en lisp on peut faire un calcul entre le premier point et les coordonées du pointeur que l'on récupère grâce à

 (cadr (grread T))

.... il doit y avoir une équivalence en VB....

[didier]

hello,

 

je n'ai pas compris ton message,

 

décris un exemple, on te soutiendra.

 

amicalement

[Tramber]

En lisp, on arme la demande de point avec le bit "choix arbitraire" (ou un truc comme ça).

Maintenant, je ne sais pas comment ca s'écrit en VBA.

[winfield]

j'ai besoin de calculer un point en donnant une distance au clavier

mais l'angle avec la souris....je crois que c'est ça.

[winfield]

Voilà l'idée :

(Si dans les outils d'autocad, ça existe déjà, veuillez m'en excusez et me le dire)

 

Le problème avec AutoCAD, lors de copies, les distances sont toujours par rapport au point de copie.

Si on doit mettre n/blocs mais jamais avec les mêmes distances (la commande réseaux est inutile) et les distances qu'on doit donné, doivent être depuis le point de copie.

Donc je m'était fais une ptite routine (à mon niveau) pour ce travail mais je veux l'améliorer dans le même sens que SU.

je prends la commande, j'indique une direction, je tapes 5 unités, je tapes 15 unités (etc),

mais si je veux faire x copies tous les 10 unités ?...........et reprendre ensuite par 4 unités, 25 unités etc etc.

Vous saisissez mieux mon problème ?

 

Je sais que c'est loin d'être parfait mais voilà ce que j'ai réussi à faire, les NbCopies tout les X_Distances ne sont pas présent car je me creuse encore la tetheu.

 

 Sub CopyContinu() 
Dim ObjEntite As AcadEntity
   Dim ObjCopy As AcadEntity
   Dim Varpoint As Variant
   Dim Dist As Variant
   Dim PtCopie As Variant
   Dim ObjSelection As AcadSelectionSet
   Dim StrNomSelection As String
   
   StrNomSelection = "MaSelection"
   
   On Error Resume Next
   
   Set ObjSelection = ThisDrawing.SelectionSets(StrNomSelection)
   If Err <> 0 Then
       Err.Clear
   Else
       ObjSelection.Delete
   End If
   Set ObjSelection = ThisDrawing.SelectionSets.Add(StrNomSelection)
   
   ObjSelection.SelectOnScreen
   If ObjSelection.Count = 0 Then
       Exit Sub
   Else
       ReDim Matrice(ObjSelection.Count - 1)
       For IntI = 0 To ObjSelection.Count - 1
           Set Matrice(IntI) = ObjSelection(IntI)
       Next
   End If
   ObjSelection.AddItems (Matrice)
   With ThisDrawing.Utility
       PtCopie = .GetPoint(, vbCr & "Point de copie")
       PtCopieSCU = .TranslateCoordinates(PtCopie, acWorld, acUCS, False)
       Dist = .GetPoint(PtCopieSCU, vbCr & "Distance ?")
       DistSCU = .TranslateCoordinates(Dist, acWorld, acUCS, False)
       For I = 0 To ObjSelection.Count - 1
           Set ObjCopy = ObjSelection.Item(I).Copy()
           ObjCopy.Move PtCopie, Dist
       Next I
       Do
           Dist = .GetPoint(DistSCU, vbCr & "Distance ?")
           DistSCU = .TranslateCoordinates(Dist, acWorld, acUCS, False)
           For Y = 0 To ObjSelection.Count - 1
               Set ObjCopy = ObjSelection.Item(Y).Copy()
               ObjCopy.Move PtCopie, Dist
           Next Y
           If Err.Description = "Argument pSelSet incorrect dans AddItems" Then
               Err.Clear
           End If
       Loop Until Err.Number <> 0
   End With
   
End Sub

Idées ? Commentaires ? je prends tout le pack :D

[phil_vsd]

Salut,

 

Hé bien il marche bien ton petit truc !

 

C'est vrai qu'il faudrait un loop à un endroit. Autant de loops que l'on voudrait de copies, puis, une fois le nombre de loops révolu, on repart sur une nouvelle donne de distance et de direction.

 

C'est pas mal, je vais m'en inspirer pour progresser.

 

J'attend avec impatience la version finale !

 

 

 

 
Set ObjSelection = ThisDrawing.SelectionSets(StrNomSelection)
If Err <> 0 Then
Err.Clear
Else
ObjSelection.Delete
End If
Set ObjSelection = ThisDrawing.SelectionSets.Add(StrNomSelection)

 

Ce petit bout de code permet d'éviter le message "La sélection existe déjà." ?

 

J'ai trois millions de questions à te poser sur ta routine parce que pour moi c'est du next level...

 

A++

[winfield]

Je suis ravi que ça te plaise :)

Ce petit bout de code permet d'éviter le message "La sélection existe déjà." ?

Yes ! (je l'ai pompé sur des codes de Pako, en passant, merci Pako !)