Code:
Dim Bohrflaeche As Reference
Dim Abstand1 As Reference
Dim Abstand2 As Reference
Dim Richtung1 As Reference
Dim Richtung2 As ReferencePrivate Sub Abstand1Button_Click()
Dim Auswahl 'As Selection
Set Auswahl = CATIA.ActiveDocument.Selection
Dim oTyp(0)
oTyp(0) = "PlanarFace"
Auswahl.Clear
Status = Auswahl.SelectElement2(oTyp, "Abstand 1 wählen", False)
If Status = "Cancel" Then Exit Sub
Set Abstand1 = Auswahl.Item(1).Value
Abstand1Text = Auswahl.Item(1).Value.Name
Auswahl.Clear
End Sub
Private Sub Abstand1Text_Enter()
If Abstand1 Is Nothing Then Exit Sub
Dim Auswahl As Selection
Set Auswahl = CATIA.ActiveDocument.Selection
Auswahl.Clear
Auswahl.Add Abstand1
End Sub
Private Sub Abstand2Button_Click()
Dim Auswahl 'As Selection
Set Auswahl = CATIA.ActiveDocument.Selection
Dim oTyp(0)
oTyp(0) = "PlanarFace"
Auswahl.Clear
Status = Auswahl.SelectElement2(oTyp, "Abstand 2 wählen", False)
If Status = "Cancel" Then Exit Sub
Set Abstand2 = Auswahl.Item(1).Reference
Abstand2Text = Auswahl.Item(1).Value.Name
Auswahl.Clear
End Sub
Private Sub Abstand2Text_Enter()
If Abstand2 Is Nothing Then Exit Sub
Dim Auswahl As Selection
Set Auswahl = CATIA.ActiveDocument.Selection
Auswahl.Clear
Auswahl.Add Abstand2
End Sub
Private Sub BohrflaecheButton_Click()
Dim Auswahl 'As Selection
Set Auswahl = CATIA.ActiveDocument.Selection
Dim oTyp(0)
oTyp(0) = "PlanarFace"
Auswahl.Clear
Status = Auswahl.SelectElement2(oTyp, "Bohrfläche wählen", False)
If Status = "Cancel" Then Exit Sub
Set Bohrflaeche = Auswahl.Item(1).Reference
BohrflaecheText = Auswahl.Item(1).Value.Name
Auswahl.Clear
End Sub
Private Sub BohrflaecheText_Enter()
If Bohrflaeche Is Nothing Then Exit Sub
Dim Auswahl As Selection
Set Auswahl = CATIA.ActiveDocument.Selection
Auswahl.Clear
Auswahl.Add Bohrflaeche
End Sub
Private Sub TextAbstandMass1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dim Erlaubt As String
Erlaubt = "0123456789,."
If InStr(1, Erlaubt, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End Sub
Private Sub TextAbstandMass2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dim Erlaubt As String
Erlaubt = "0123456789,."
If InStr(1, Erlaubt, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End Sub
Private Sub Richtung1Button_Click()
Dim Auswahl 'As Selection
Set Auswahl = CATIA.ActiveDocument.Selection
Dim oTyp(0)
oTyp(0) = "RectilinearTriDimFeatEdge"
Auswahl.Clear
Status = Auswahl.SelectElement2(oTyp, "Richtung 1 wählen", False)
If Status = "Cancel" Then Exit Sub
Set Richtung1 = Auswahl.Item(1).Value
Richtung1Text = Auswahl.Item(1).Value.Name
Auswahl.Clear
End Sub
Private Sub Richtung1Text_Enter()
If Richtung1 Is Nothing Then Exit Sub
Dim Auswahl As Selection
Set Auswahl = CATIA.ActiveDocument.Selection
Auswahl.Clear
Auswahl.Add Richtung1
End Sub
Private Sub Richtung2Button_Click()
Dim Auswahl 'As Selection
Set Auswahl = CATIA.ActiveDocument.Selection
Dim oTyp(0)
oTyp(0) = "RectilinearTriDimFeatEdge"
Auswahl.Clear
Status = Auswahl.SelectElement2(oTyp, "Richtung 2 wählen", False)
If Status = "Cancel" Then Exit Sub
Set Richtung2 = Auswahl.Item(1).Value
Richtung2Text = Auswahl.Item(1).Value.Name
Auswahl.Clear
End Sub
Private Sub Richtung2Text_Enter()
If Richtung2 Is Nothing Then Exit Sub
Dim Auswahl As Selection
Set Auswahl = CATIA.ActiveDocument.Selection
Auswahl.Clear
Auswahl.Add Richtung2
End Sub
Private Sub UserForm_Initialize()
RasterCombo.AddItem 10
RasterCombo.AddItem 15
BohrungenCombo.AddItem 3
BohrungenCombo.AddItem 4
Dim Typen As Shapes
Set Typen = CATIA.ActiveDocument.Part.Bodies.Item("Bohrbearbeitung").Shapes
For i = 1 To Typen.Count
Typ1Combo.AddItem Replace(Typen.Item(i).Name, "_", " ")
Typ2Combo.AddItem Replace(Typen.Item(i).Name, "_", " ")
Next i
Typ1Combo = "Passungen H7"
Typ2Combo = "Gewinde"
End Sub
Private Function BohrungSetzen(ByVal Bohrtyp As Body) As Hole
Dim Teil As Part
Set Teil = CATIA.ActiveDocument.Part
Teil.InWorkObject = Bohrtyp
Dim Bohrer As ShapeFactory
Set Bohrer = Teil.ShapeFactory
Dim Bohrung As Hole
Set Bohrung = Bohrer.AddNewHole(Bohrflaeche, 20) 'Bohrung setzten
Teil.InWorkObject = Bohrung.Sketch
Dim Bemassung As Factory2D
Set Bemassung = Bohrung.Sketch.OpenEdition()
Dim Punkt As Reference
Set Punkt = Teil.CreateReferenceFromObject(Bohrung.Sketch.GeometricElements.Item(2))
Dim Bedingung1 As Constraint
Set Bedingung1 = Bohrung.Sketch.Constraints.AddBiEltCst(catCstTypeDistance, Abstand1, Punkt) '<--Fehler
Bedingung1.Mode = catCstModeDrivingDimension
Bedingung1.Dimension.Value = 10
Dim Bedingung2 As Constraint
Set Bedingung2 = Bohrung.Sketch.Constraints.AddBiEltCst(catCstTypeDistance, Abstand2, Punkt)
Bedingung2.Mode = catCstModeDrivingDimension
Bedingung2.Dimension.Value = 10
Bohrung.Sketch.CloseEdition
Teil.InWorkObject = Bohrung
With Bohrung
.Diameter.Value = TextDurchmesser1
End With
Teil.Update
End Function
Private Sub VorschauButton_Click()
Dim Teil As Part
Set Teil = CATIA.ActiveDocument.Part
Dim Bohrtyp As Body
Set Bohrtyp = Teil.Bodies.Item(Replace(Typ1Combo, " ", "_"))
Dim Bohrung1 As Hole
Set Bohrung1 = BohrungSetzen(Bohrtyp)
Set Bohrtyp = Teil.Bodies.Item(Replace(Typ2Combo, " ", "_"))
Dim Bohrung2 As Hole
Set Bohrung2 = BohrungSetzen(Bohrtyp)
Teil.InWorkObject = Teil.MainBody
End Sub