WIP: Прец. редуктор вер.4 #91

Draft
movefasta wants to merge 2 commits from Prec_reducer_version_4 into main
20 changed files with 324 additions and 0 deletions

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View file

@ -0,0 +1,166 @@
Option Explicit
Sub Main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSketchMgr As SldWorks.SketchManager
Dim swPart As SldWorks.PartDoc
Dim points() As Double
Dim i As Integer
Dim Z1, Z2 As Integer
Dim t As Double
Dim x, y, z As Double
Dim numPoints As Integer
Dim radius As Double
Dim numTurns As Double
Dim height As Double
Dim boolStatus As Boolean
Dim cone_angle As Double
Dim nutation_angle As Double
Dim prec_angle As Double
'Dim swSketchPoint As SldWorks.SketchPoint
Dim swSketchSegment As SldWorks.SketchSegment
' Iiaee??aiea e SolidWorks
Debug.Print "1. Attempting to connect to SolidWorks"
On Error Resume Next
Set swApp = Application.SldWorks
If swApp Is Nothing Then
MsgBox "Ia oaaeinu iiaee??eouny e SolidWorks!", vbCritical
Debug.Print "1. Failed to connect to SolidWorks"
Exit Sub
End If
On Error GoTo 0
Debug.Print "1. Successfully connected to SolidWorks"
' I?iaa?ea aeoeaiiai aieoiaioa
Debug.Print "2. Checking active document"
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "Ioe?ieoa aieoiaio aaoaee a SolidWorks!", vbExclamation
Debug.Print "2. No active document found"
Exit Sub
End If
Debug.Print "2. Active document found: " & swModel.GetTitle
' I?iaa?ea, ?oi yoi aieoiaio aaoaee
If swModel.GetType <> swDocPART Then
MsgBox "Aeoeaiue aieoiaio aie?ai auou aaoaeu?!", vbExclamation
Debug.Print "2. Document is not a part, type: " & swModel.GetType
Exit Sub
End If
Set swPart = swModel
Debug.Print "2. Document is a part"
' Eieoeaeecaoey SketchManager
Debug.Print "3. Initializing SketchManager"
Set swSketchMgr = swModel.SketchManager
If swSketchMgr Is Nothing Then
MsgBox "Ia oaaeinu eieoeaeece?iaaou SketchManager!", vbCritical
Debug.Print "3. Failed to initialize SketchManager"
Exit Sub
End If
Debug.Print "3. SketchManager initialized"
' I?iaa?ea e cae?uoea aeoeaiiai yneeca
Debug.Print "4. Checking for active sketch"
If Not swSketchMgr.ActiveSketch Is Nothing Then
swSketchMgr.InsertSketch True ' Cae?uou oaeouee yneec
swModel.ClearSelection2 True ' I?enoea auaaeaiey
Debug.Print "4. Closed active sketch"
Else
Debug.Print "4. No active sketch found"
End If
' Onoaiiaea ?a?eia yneeca
Debug.Print "5. Setting sketch mode"
swModel.SketchManager.AddToDB = False ' Ioee??aiea i?yiie caiene aey nei?inoe
' Nicaaiea 3D-yneeca
Debug.Print "6. Creating 3D sketch"
On Error Resume Next
swModel.SketchManager.Insert3DSketch True
If Err.Number <> 0 Then
MsgBox "Ioeaea i?e nicaaiee 3D-yneeca: " & Err.Description, vbCritical
Debug.Print "6. Error creating 3D sketch: " & Err.Description
On Error GoTo 0
Exit Sub
End If
On Error GoTo 0
Debug.Print "6. 3D sketch created successfully"
' Iano?aeaaaiua ia?aiao?u oanoa?aiee
Z2 = 60
Z1 = Z2 - 1
radius = 60 ' ?aaeon nie?aee (a ieeeeiao?ao)
radius = radius / 1000 ' ?aaeon nie?aee (a iao?ao)
numPoints = 360 ' Eiee?anoai eiio?ieuiuo oi?ae
cone_angle = 10
nutation_angle = 5
prec_angle = 5
' Eieoeaeecaoey ianneaa oi?ae
ReDim points(0 To numPoints * 3 - 1) ' [x1, y1, z1, x2, y2, z2, ...]
' Aaia?aoey eii?aeiao oi?ae (nie?aeu)
Debug.Print "7. Generating control points"
For i = 0 To numPoints - 1
x = radius * Cos(cone_angle) * (-1 * Cos(prec_angle) * Sin(prec_angle * (Z1 / Z2)) + Sin(prec_angle) * Cos(prec_angle * (Z1 / Z2)) * Cos(nutation_angle)) - (radius * Sin(cone_angle) * Sin(prec_angle) * Sin(nutation_angle))
y = -1 * radius * Cos(cone_angle) * (Sin(prec_angle) * Sin(prec_angle * (Z1 / Z2)) + Cos(prec_angle) * Cos(prec_angle * (Z1 / Z2)) * Cos(nutation_angle)) + (radius * Sin(cone_angle) * Cos(prec_angle) * Sin(nutation_angle))
z = -1 * radius * Cos(cone_angle) * Cos(prec_angle * (Z1 / Z2)) * Sin(nutation_angle) - (radius * Sin(cone_angle) * Cos(nutation_angle))
points(i * 3) = x
points(i * 3 + 1) = y
points(i * 3 + 2) = z
Debug.Print "7. Point " & i & ": (" & x & ", " & y & ", " & z & ")"
Next i
' For i = 0 To numPoints - 1
' t = i / (numPoints - 1)
' x = radius * Cos(numTurns * 2 * 3.14159 * t)
' y = radius * Sin(numTurns * 2 * 3.14159 * t)
' z = height * t
' points(i * 3) = x
' points(i * 3 + 1) = y
' points(i * 3 + 2) = z
' Debug.Print "7. Point " & i & ": (" & x & ", " & y & ", " & z & ")"
' Next i
Debug.Print "7. Control points generated"
' Nicaaiea nieaeia
Debug.Print "8. Creating spline"
Debug.Print "Err.Number: " & Err.Number
On Error Resume Next
' boolStatus = swSketchMgr.CreateSpline(points)
Set swSketchSegment = swSketchMgr.CreateSpline2((points), True)
' If Err.Number <> 0 Then
' MsgBox "Ioeaea i?e nicaaiee nieaeia: " & Err.Description, vbCritical
' Debug.Print "8. Error creating spline: " & Err.Description
' swSketchMgr.InsertSketch False
' On Error GoTo 0
' Exit Sub
'End If
'If Not boolStatus Then
' MsgBox "Ia oaaeinu nicaaou nieaei! I?iaa?uoa ia?aiao?u.", vbCritical
' Debug.Print "8. Failed to create spline"
' swSketchMgr.InsertSketch False
' Exit Sub
'End If
'On Error GoTo 0
'Debug.Print "8. Spline created successfully"
' Caaa?oaiea yneeca
Debug.Print "9. Closing sketch"
swSketchMgr.InsertSketch True
Debug.Print "9. Sketch closed"
' Iaiiaeaiea iiaaee
Debug.Print "10. Rebuilding model"
swModel.ForceRebuild3 True
Debug.Print "10. Model rebuilt"
' Niiauaiea ia oniaoiii caaa?oaiee
MsgBox "3D-nieaei oniaoii nicaai!", vbInformation
End Sub

View file

@ -0,0 +1,158 @@
Option Explicit
Sub Main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSketchMgr As SldWorks.SketchManager
Dim swPart As SldWorks.PartDoc
Dim points() As Double
Dim i As Integer
Dim t As Double
Dim x, y, z As Double
Dim numPoints As Integer
Dim radius As Double
Dim numTurns As Double
Dim height As Double
Dim boolStatus As Boolean
'Dim swSketchPoint As SldWorks.SketchPoint
Dim swSketchSegment As SldWorks.SketchSegment
' ????????????? ????????? ???????
radius = 0.01 ' ?aaeon nie?aee (a iao?ao)
numTurns = 2 ' Eiee?anoai aeoeia nie?aee
height = 0.01 ' Aunioa nie?aee (a iao?ao)
numPoints = 10 ' Eiee?anoai eiio?ieuiuo oi?ae
' Iiaee??aiea e SolidWorks
Debug.Print "1. Attempting to connect to SolidWorks"
On Error Resume Next
Set swApp = Application.SldWorks
If swApp Is Nothing Then
MsgBox "Ia oaaeinu iiaee??eouny e SolidWorks!", vbCritical
Debug.Print "1. Failed to connect to SolidWorks"
Exit Sub
End If
On Error GoTo 0
Debug.Print "1. Successfully connected to SolidWorks"
' I?iaa?ea aeoeaiiai aieoiaioa
Debug.Print "2. Checking active document"
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "Ioe?ieoa aieoiaio aaoaee a SolidWorks!", vbExclamation
Debug.Print "2. No active document found"
Exit Sub
End If
Debug.Print "2. Active document found: " & swModel.GetTitle
' I?iaa?ea, ?oi yoi aieoiaio aaoaee
If swModel.GetType <> swDocPART Then
MsgBox "Aeoeaiue aieoiaio aie?ai auou aaoaeu?!", vbExclamation
Debug.Print "2. Document is not a part, type: " & swModel.GetType
Exit Sub
End If
Set swPart = swModel
Debug.Print "2. Document is a part"
' Eieoeaeecaoey SketchManager
Debug.Print "3. Initializing SketchManager"
Set swSketchMgr = swModel.SketchManager
If swSketchMgr Is Nothing Then
MsgBox "Ia oaaeinu eieoeaeece?iaaou SketchManager!", vbCritical
Debug.Print "3. Failed to initialize SketchManager"
Exit Sub
End If
Debug.Print "3. SketchManager initialized"
' I?iaa?ea e cae?uoea aeoeaiiai yneeca
Debug.Print "4. Checking for active sketch"
If Not swSketchMgr.ActiveSketch Is Nothing Then
swSketchMgr.InsertSketch True ' Cae?uou oaeouee yneec
swModel.ClearSelection2 True ' I?enoea auaaeaiey
Debug.Print "4. Closed active sketch"
Else
Debug.Print "4. No active sketch found"
End If
' Onoaiiaea ?a?eia yneeca
Debug.Print "5. Setting sketch mode"
swModel.SketchManager.AddToDB = False ' Ioee??aiea i?yiie caiene aey nei?inoe
' Nicaaiea 3D-yneeca
Debug.Print "6. Creating 3D sketch"
On Error Resume Next
swModel.SketchManager.Insert3DSketch True
If Err.Number <> 0 Then
MsgBox "Ioeaea i?e nicaaiee 3D-yneeca: " & Err.Description, vbCritical
Debug.Print "6. Error creating 3D sketch: " & Err.Description
On Error GoTo 0
Exit Sub
End If
On Error GoTo 0
Debug.Print "6. 3D sketch created successfully"
' Eieoeaeecaoey ianneaa oi?ae
ReDim points(0 To numPoints * 3 - 1) ' [x1, y1, z1, x2, y2, z2, ...]
' Aaia?aoey eii?aeiao oi?ae (nie?aeu)
Debug.Print "7. Generating control points"
For i = 0 To numPoints - 1
t = i / (numPoints - 1)
x = radius * Cos(numTurns * 2 * 3.14159 * t)
y = radius * Sin(numTurns * 2 * 3.14159 * t)
z = height * t
points(i * 3) = x
points(i * 3 + 1) = y
points(i * 3 + 2) = z
Debug.Print "7. Point " & i & ": (" & x & ", " & y & ", " & z & ")"
Next i
Debug.Print "7. Control points generated"
' Nicaaiea nieaeia
Debug.Print "8. Creating spline"
Debug.Print "Err.Number: " & Err.Number
On Error Resume Next
' boolStatus = swSketchMgr.CreateSpline(points)
Set swSketchSegment = swSketchMgr.CreateSpline2((points), True)
' If Err.Number <> 0 Then
' MsgBox "Ioeaea i?e nicaaiee nieaeia: " & Err.Description, vbCritical
' Debug.Print "8. Error creating spline: " & Err.Description
' swSketchMgr.InsertSketch False
' On Error GoTo 0
' Exit Sub
'End If
'If Not boolStatus Then
' MsgBox "Ia oaaeinu nicaaou nieaei! I?iaa?uoa ia?aiao?u.", vbCritical
' Debug.Print "8. Failed to create spline"
' swSketchMgr.InsertSketch False
' Exit Sub
'End If
'On Error GoTo 0
'Debug.Print "8. Spline created successfully"
' Caaa?oaiea yneeca
Debug.Print "9. Closing sketch"
swSketchMgr.InsertSketch True
Debug.Print "9. Sketch closed"
' Iaiiaeaiea iiaaee
Debug.Print "10. Rebuilding model"
swModel.ForceRebuild3 True
Debug.Print "10. Model rebuilt"
' Niiauaiea ia oniaoiii caaa?oaiee
MsgBox "3D-nieaei oniaoii nicaai!", vbInformation
End Sub
' 7. Point 0: (0,01, 0, 0)
' 7. Point 1: (1,73649339122722E-03, 9,84807548215509E-03, 1,11111111111111E-03)
' 7. Point 2: (-9,39691814044484E-03, 3,42022359821382E-03, 2,22222222222222E-03)
' 7. Point 3: (-5,00003064098434E-03, -8,66023634719156E-03, 3,33333333333333E-03)
' 7. Point 4: (7,66041410764426E-03, -6,42791223488659E-03, 4,44444444444444E-03)
' 7. Point 5: (7,66048233538193E-03, 6,42783092413774E-03, 5,55555555555556E-03)
' 7. Point 6: (-4,99993871784355E-03, 8,66028941882481E-03, 6,66666666666667E-03)
' 7. Point 7: (-9,39695444339722E-03, -3,42012385575689E-03, 7,77777777777778E-03)
' 7. Point 8: (1,73638886011905E-03, -9,84809391336488E-03, 8,88888888888889E-03)
' 7. Point 9: (9,99999999943668E-03, -1,06143591732241E-07, 0,01)