Hello,
I have a problem. Attached is the code that creates a solid based on data from a UserForm. Everything works fine, but it cannot create the solid — and previously even the sketch — when the dimensions are small, for example 1.2 mm. I design in [mm].
Another important requirement is that the rectangle must be created from the center so that the main reference planes pass through both the sketch and the resulting solid.
'___________________________
Option Explicit
Public swApp As SldWorks.SldWorks
Public swModel As SldWorks.ModelDoc2
Public Sub CreateBOX_Simple()
Const SZER_MM As Double = 1.2
Const WYS_MM As Double = 2.2
Const DL_MM As Double = 200
Dim mmToM As Double
mmToM = 0.001
Dim boolstatus As Boolean
Dim longstatus As Long
Dim myFeature As Object
Dim hDatumObj As Object
Dim vDatumObj As Object
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "No active document.", vbExclamation
Exit Sub
End If
If swModel.GetType <> swDocPART Then
MsgBox "The active document must be part of SLDPRT.", vbExclamation
Exit Sub
End If
' Front Plane
boolstatus = swModel.Extension.SelectByID2( _
"Front", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
' Start szkicu
swModel.SketchManager.InsertSketch True
' Prostokąt ze środka
swModel.SketchManager.CreateCenterRectangle _
0, 0, 0, _
(SZER_MM * mmToM) / 2, _
(WYS_MM * mmToM) / 2, _
0
' ===== FULL DIMENSIONING =====
swModel.ClearSelection2 True
boolstatus = swModel.Extension.SelectByID2( _
"Point*@Origin", "EXTSKETCHPOINT", _
0, 0, 0, True, 6, Nothing, 0)
boolstatus = swModel.Extension.SelectByID2( _
"Line*", "SKETCHSEGMENT", _
0, 0, 0, True, 6, Nothing, 0)
longstatus = swModel.SketchManager.FullyDefineSketch( _
True, True, 1023, True, _
3, hDatumObj, _
3, vDatumObj, _
-1, -1)
swModel.ClearSelection2 True
' End of draft
swModel.SketchManager.InsertSketch True
'Extraction' Mid Plane
Set myFeature = swModel.FeatureManager.FeatureExtrusion2( _
True, False, False, _
6, 0, _
DL_MM * mmToM, 0, _
False, False, False, False, _
0, 0, _
False, False, False, False, _
True, True, True, _
0, 0, False)
swModel.ForceRebuild3 True
MsgBox "The solid has been created."
End Sub
'________________________________________________
