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
Probeer dit eens:
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
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
Dit kan je doen door de code in een module te plakken,
dan dubbelklikken op je CommandButton op je UserForm, en volgende code toevoegen:
Call Module1.rijboring
Waarbij Module1 de naam van je module is, en rijboring de methode die je wil aanroepen.
Zie voorbeeld in bijlage.
Bedankt daarvoor steven, het voorbeeld was een goede hulp.
Greetz, Seppe