SelectOnScreen

[Stagiar]

Elk z'n dag,

Na een tijd zoeken en doen vind ik maar niet hoe je via VBA in autocad2004  ervoor kunt zorgen, dat je 2 cirkels handmatig kunt aanklikken zodat daartussen automatisch een rijboring kan verschijnen. Ik denk dat het via selectOnScreen zou moeten, maar de vraag is Hoe.

In bijlage een afbeeldiing ter verduidelijking.

Alvast bedankt

[Steven]

Probeer dit eens:

Code Selecteer Uitklappen

Public Sub rijboring()

'Variabelen
Dim retObj1 As AcadObject
Dim retObj2 As AcadObject

Dim retPunt1(0 To 2) As Double
Dim retPunt2(0 To 2) As Double

Dim Cirkel1 As AcadCircle
Dim Cirkel2 As AcadCircle

Dim punt1(0 To 2) As Double
Dim punt2(0 To 2) As Double

Dim lengte As Double
Dim minAfstand As Double
minAfstand = 100
Dim afstand As Double
Dim aantal As Double

'Duid de eerste cirkel aan
Cirkel1:
ThisDrawing.Utility.GetEntity retObj1, retPunt1, "Duid de eerste cirkel aan..."

'Controleer of het een cirkel is
If retObj1.ObjectName = "AcDbCircle" Then
   
    Set Cirkel1 = retObj1
   
    punt1(0) = Cirkel1.center(0)
    punt1(1) = Cirkel1.center(1)
    punt1(2) = Cirkel1.center(2)

Else

    MsgBox "Geen cirkel!"
    GoTo Cirkel1

End If

'Duid de tweede cirkel aan
Cirkel2:
ThisDrawing.Utility.GetEntity retObj2, retPunt2, "Duid de tweede cirkel aan..."

'Controleer of het een cirkel is
If retObj2.ObjectName = "AcDbCircle" Then

    Set Cirkel2 = retObj2

    punt2(0) = Cirkel2.center(0)
    punt2(1) = Cirkel2.center(1)
    punt2(2) = Cirkel2.center(2)

Else

    MsgBox "Geen cirkel!"
    GoTo Cirkel2

End If

'rijboring in Y richting
If punt1(0) = punt2(0) Then

    lengte = Abs(punt1(1) - punt2(1))
    aantal = Round(((lengte - (minAfstand * 2)) / 32), 0)
    afstand = ((lengte - (32 * aantal)) / 2)
   
        If punt1(1) < punt2(1) Then
       
            Yrichting punt1(0), punt1(1), afstand, aantal
           
        Else
       
            Yrichting punt2(0), punt2(1), afstand, aantal
       
        End If
       

End If

'rijboring in X richting
If punt1(1) = punt2(1) Then

    lengte = Abs(punt1(0) - punt2(0))
    aantal = Round((lengte - (minAfstand * 2)) / 32)
    afstand = ((lengte - (32 * aantal)) / 2)
   
    If punt1(0) < punt2(0) Then
       
            Xrichting punt1(0), punt1(1), afstand, aantal
           
        Else
       
            Xrichting punt2(0), punt2(1), afstand, aantal
       
        End If

End If


End Sub

Sub Yrichting(xPunt As Double, yPunt As Double, afstand As Double, aantal As Double)

    Dim rijboring As AcadCircle
    Dim center(0 To 2) As Double
    center(0) = xPunt
    center(1) = yPunt
    center(2) = 0
   
    For i = 1 To aantal - 1
       
        center(1) = yPunt + afstand + (32 * i)
        Set rijboring = ThisDrawing.ModelSpace.AddCircle(center, 2.5)
   
    Next i

End Sub


Sub Xrichting(xPunt As Double, yPunt As Double, afstand As Double, aantal As Double)

    Dim rijboring As AcadCircle
    Dim center(0 To 2) As Double
    center(0) = xPunt
    center(1) = yPunt
    center(2) = 0
   
    For i = 1 To aantal - 1
       
        center(0) = xPunt + afstand + (32 * i)
        Set rijboring = ThisDrawing.ModelSpace.AddCircle(center, 2.5)
   
    Next i

End Sub


[Stagiar]

Dit programma zo ik willen via een userform te laten uitvoeren, door te drukken op een Commandbutton.
Maar na enkele uren zoeken, vind ik maar geen oplossing,
Wel weet ik dat het mogelijk is om een Userform aan een module te kopelen, via Call Userform1.show,
Maar kan dit ook omgekeerd, Dus een module oproepen in een userform (een module laten activeren in een userform)

mvg,
Seppe

[Steven]

Dit kan je doen door de code in een module te plakken,
dan dubbelklikken op je CommandButton op je UserForm, en volgende code toevoegen:

Code Selecteer Uitklappen

Call Module1.rijboring

Waarbij Module1 de naam van je module is, en rijboring de methode die je wil aanroepen.
Zie voorbeeld in bijlage.

[Stagiar]

Bedankt daarvoor steven, het voorbeeld was een goede hulp.

Greetz, Seppe