12-09-2021
11:16 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
12-09-2021
11:16 PM
Hello!
I made a rule to simply engrave text.
You select a surface, run rule, enter text, rotate if needed and that's it. it cuts "up to next". You can later just edit sketch to place the text somewhere else.
I made this rule for my coworker, and it works on my computer. However, it doesn't work on any other computer. Can you please tell me what is wrong with the code?
Dim oDoc As Document
oDoc = ThisDoc.Document
oAssDoc = ThisApplication.ActiveDocument
oAssDef = oAssDoc.ComponentDefinition
Dim Oznaka As String
Oznaka = InputBox("Vnos parametra", "Vnesi ime bloka", "")
If oAssDoc.SelectSet.Count = 0 Then
MsgBox("Najprej izberi površino, nato zaženi rule.",,"")
Exit Sub
Else
'definiraj označeno ravnino
oFace = oAssDoc.SelectSet(1)
'Preveri da je ravnina
If oFace.SurfaceType = SurfaceTypeEnum.kPlaneSurface Then
oPlanarSurface = oFace.Geometry
'dodaj sketch
oSketch = oAssDef.Sketches.Add(oFace)
'definiranje točke sredine
'Predviden je en closed loop
oEdgeLoop = oFace.EdgeLoops(1)
oMinPt = oEdgeLoop.RangeBox.MinPoint
oMaxPt = oEdgeLoop.RangeBox.MaxPoint
CenterPt = ThisApplication.TransientGeometry.CreatePoint((oMaxPt.X + oMinPt.X) / 2#, (oMaxPt.Y + oMinPt.Y) / 2#, (oMaxPt.Z + oMinPt.Z) / 2#)
'get one point on the face and transform to the point2d on the sketch
oTextPt = oSketch.ModelToSketchSpace(CenterPt)
'dodajanje textboxa
oSketchText = oSketch.TextBoxes.AddFitted(oTextPt, Oznaka)
For Each oTextBox In oSketch.TextBoxes
'definiranje fonta in velikosti
oTextBox.FormattedText = "<StyleOverride FontSize = '0.8' Font = 'Arial'>" & oTextBox.Text & "</StyleOverride>"
'ROTACIJA
Dim rotacija As String
rotacija = InputBox("Rotacija v smeri ure. Inkrement po 90 stopinj", "Rotacija", "")
Select Case rotacija
Case "0"
oTextBox.Rotation = 0
Case ""
oTextBox.Rotation = 0
Case "90"
oTextBox.Rotation = -PI/2
Case "180"
oTextBox.Rotation = -PI
Case "270"
oTextBox.Rotation = -PI*1.5
Case "-90"
oTextBox.Rotation = -PI * 1.5
End Select
'/ROTACIJA
Next
Else
MsgBox( "Izbrana površina ni ravna!")
End If
End If
'extrudiranje sketcha
oSketch.Edit
If TypeOf ThisApplication.ActiveEditObject Is Sketch Then
'Do nothing
Else
MessageBox.Show("Napaka", "ilogic")
Return
End If
Dim oPartDoc As PartDocument
oPartDoc = ThisApplication.ActiveDocument
Dim oCompDef As PartComponentDefinition
oCompDef = oPartDoc.ComponentDefinition
' Create a profile.
Dim oProfile As Profile
On Error GoTo NoProfile
oProfile = oSketch.Profiles.AddForSolid
'naslednji opciji sta neuporabljene - gre za parametre extruda
'oDirection = InputRadioBox("Select Extrude Direction", "Up (+)", "Down (-)", True, Title := "iLogic")
'oJoinOrCut = InputRadioBox("Select Extrude Solution", "Join", "Cut", True, Title := "iLogic")
oDirection=False
oJoinOrCut=False
If oDirection = True Then
oDirection = kPositiveExtentDirection
Else
oDirection = kNegativeExtentDirection
End If
If oJoinOrCut = True Then
oJoinOrCut = kJoinOperation
Else
oJoinOrCut = kCutOperation
End If
Dim oTerminator As SurfaceBody
oTerminator = oCompDef.SurfaceBodies(1)
' Create an extrusion
Dim oExtrude As ExtrudeFeature
On Error GoTo NoExtrude
oExtrude = oCompDef.Features.ExtrudeFeatures.AddByToNextExtent( _
oProfile, oDirection, oTerminator, oJoinOrCut)
ThisApplication.CommandManager.ControlDefinitions.Item("FinishSketch").Execute
iLogicVb.UpdateWhenDone = True
Exit Sub
NoProfile:
MessageBox.Show("No closed profile found", "iLogic")
Return
NoExtrude:
MessageBox.Show("No extrusion created, check your inputs.", "iLogic")
Return
Thanks
Solved! Go to Solution.