' ============================================================ ' Proxima C -> Autodesk Inventor build script (VBScript) ' Project : set_of_gears ' Target : Autodesk_Inventor_2026 ' Units : mm (emitted to API in cm) ' Created : 2026-07-30 10:38 ' NOTE: Inventor API uses centimetres; mm values are divided by 10. ' ============================================================ Option Explicit Dim oApp, oTG, RootPath, LogPath Dim gDirPos, gDirNeg, gDirSym ' discovered extent-direction enum values (cached) Dim gCylType, gCircType, gPlaneType ' discovered SurfaceType (cylinder/plane) + CurveType (circle) enums Dim gUsed ' hole edges already taken in the current assembly Dim gInserts, gInsertTags ' emitted insert constraints by occ-pair — the RESEAT actuator's handles RootPath = "C:\\Users\\rwebs\\OneDrive\\Documents\\Proxima_Projects\\set_of_gears" LogPath = RootPath & "\ProximaC_build.log" Sub StartLog() On Error Resume Next Dim fso : Set fso = CreateObject("Scripting.FileSystemObject") fso.CreateTextFile(LogPath, True).WriteLine "Proxima C build " & Now End Sub Sub LogLine(s) On Error Resume Next Dim fso, ts Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.OpenTextFile(LogPath, 8, True) ts.WriteLine s ts.Close End Sub Function GetInventor() On Error Resume Next Set GetInventor = GetObject(, "Inventor.Application") If GetInventor Is Nothing Then Set GetInventor = CreateObject("Inventor.Application") End Function Sub EnsureFolder(p) Dim fso : Set fso = CreateObject("Scripting.FileSystemObject") If Not fso.FolderExists(p) Then fso.CreateFolder p End Sub Sub SetMaterial(doc, matName) On Error Resume Next ' material library names vary; best effort Err.Clear doc.ComponentDefinition.Material = doc.Materials.Item(matName) If Err.Number 0 Then LogLine " [material] '" & matName & "' not in the library — part keeps its DEFAULT material (mass properties will be wrong)" : Err.Clear End Sub Function AddOcc(oDef, path, xMm, yMm, zMm, rotZDeg) On Error Resume Next Dim oM Set oM = oTG.CreateMatrix ' Array-law bridges are ROTATED to their span axis (Phase B); everything else passes 0. If Abs(rotZDeg) > 0.001 Then Call oM.SetToRotation(rotZDeg * 0.017453292519943295, oTG.CreateVector(0, 0, 1), oTG.CreatePoint(0, 0, 0)) End If Call oM.SetTranslation(oTG.CreateVector(xMm/10.0, yMm/10.0, zMm/10.0)) If CreateObject("Scripting.FileSystemObject").FileExists(path) Then Set AddOcc = oDef.Occurrences.Add(path, oM) End If End Function Sub AddFlush(oCons, oA, oB, idx, offMm) On Error Resume Next Err.Clear Dim wpA, wpB, pA, pB Set wpA = oA.Definition.WorkPlanes.Item(idx) Set wpB = oB.Definition.WorkPlanes.Item(idx) Call oA.CreateGeometryProxy(wpA, pA) Call oB.CreateGeometryProxy(wpB, pB) Call oCons.AddFlushConstraint(pA, pB, offMm/10.0) If Err.Number 0 Then LogLine " [flush] axis " & idx & ": FAIL " & Err.Number & " " & Err.Description : Err.Clear End Sub Sub LocateOcc(oCons, oA, oB, xMm, yMm, zMm) On Error Resume Next If (oA Is Nothing) Or (oB Is Nothing) Then Exit Sub AddFlush oCons, oA, oB, 1, xMm AddFlush oCons, oA, oB, 2, yMm AddFlush oCons, oA, oB, 3, zMm End Sub Sub SetExtent(oExtDef, distCm, intent) Dim cands, i, cached Select Case intent Case "neg" : cached = gDirNeg Case "sym" : cached = gDirSym Case Else : cached = gDirPos End Select If Not IsEmpty(cached) Then oExtDef.SetDistanceExtent distCm, cached Exit Sub End If Select Case intent Case "neg" : cands = Array(20994, 20996, 12038, 2) Case "sym" : cands = Array(20995, 12040, 3) Case Else : cands = Array(20993, 20992, 12039, 1) End Select For i = 0 To UBound(cands) Err.Clear oExtDef.SetDistanceExtent distCm, cands(i) If Err.Number = 0 Then Select Case intent Case "neg" : gDirNeg = cands(i) Case "sym" : gDirSym = cands(i) Case Else : gDirPos = cands(i) End Select LogLine " [dir] intent=" & intent & " -> " & cands(i) Exit Sub End If Next LogLine " [warn] no accepted extent direction for intent=" & intent End Sub Function AllEdges(oDef) Dim ec, b, e Set ec = oApp.TransientObjects.CreateEdgeCollection For Each b In oDef.SurfaceBodies For Each e In b.Edges ec.Add e Next Next Set AllEdges = ec End Function Function FaceByZ(oOcc, wantTop) On Error Resume Next Dim b, f, best, bestZ, p Set best = Nothing If wantTop Then bestZ = -1E30 Else bestZ = 1E30 For Each b In oOcc.SurfaceBodies For Each f In b.Faces Set p = f.PointOnFace If Not (p Is Nothing) Then If wantTop Then If p.Z > bestZ Then bestZ = p.Z : Set best = f Else If p.Z bestA Then bestA = a : gCylType = f.SurfaceType Next Next For Each b In def.SurfaceBodies For Each f In b.Faces If f.SurfaceType gCylType Then gPlaneType = f.SurfaceType : Exit For Next Next For Each b In def.SurfaceBodies For Each e In b.Edges gCircType = e.GeometryType : Exit For Next Next doc.Close(True) LogLine " [probe] cylinder=" & gCylType & " plane=" & gPlaneType & " circle=" & gCircType End Sub Function CylFaceNearR(oOcc, rCm) On Error Resume Next Dim b, f Set CylFaceNearR = Nothing If IsEmpty(gCylType) Then Exit Function For Each b In oOcc.SurfaceBodies For Each f In b.Faces If f.SurfaceType = gCylType Then If Abs(f.Geometry.Radius - rCm) < 0.06 Then Set CylFaceNearR = f : Exit Function End If Next Next End Function Function CylFaceConsume(oOcc, rCm, usedDict, keyPrefix) On Error Resume Next Dim b, f, c, k, skip Set CylFaceConsume = Nothing If IsEmpty(gCylType) Then Exit Function For Each b In oOcc.SurfaceBodies For Each f In b.Faces If f.SurfaceType = gCylType Then If Abs(f.Geometry.Radius - rCm) < 0.08 Then Set c = f.Geometry.BasePoint k = keyPrefix & "|" & CLng(c.X*100) & "," & CLng(c.Y*100) skip = False If Not (usedDict Is Nothing) Then If usedDict.Exists(k) Then skip = True If Not skip Then If Not (usedDict Is Nothing) Then usedDict.Add k, True Set CylFaceConsume = f : Exit Function End If End If End If Next Next End Function Function BoltCylProxy(oOcc, rCm) On Error Resume Next Dim b, f, fp Set BoltCylProxy = Nothing If IsEmpty(gCylType) Then Exit Function For Each b In oOcc.Definition.SurfaceBodies For Each f In b.Faces If f.SurfaceType = gCylType Then If Abs(f.Geometry.Radius - rCm) < 0.06 Then Set fp = Nothing : oOcc.CreateGeometryProxy f, fp If Not (fp Is Nothing) Then Set BoltCylProxy = fp : Exit Function End If End If Next Next End Function Function CylFaceNearestXY(oOcc, rCm, tx, ty) On Error Resume Next Dim b, f, fp, c, dx, dy, dist, bestD Set CylFaceNearestXY = Nothing : bestD = 1E30 If IsEmpty(gCylType) Then Exit Function For Each b In oOcc.Definition.SurfaceBodies For Each f In b.Faces If f.SurfaceType = gCylType Then If Abs(f.Geometry.Radius - rCm) < 0.06 Then Set fp = Nothing : oOcc.CreateGeometryProxy f, fp If Not (fp Is Nothing) Then Set c = fp.Geometry.BasePoint dx = c.X - tx : dy = c.Y - ty : dist = dx*dx + dy*dy If dist bestZ) Or ((Not hi) And z a1 Then a2 = a1 : Set f2 = f1 : a1 = a : Set f1 = f ElseIf a > a2 Then a2 = a : Set f2 = f End If End If Next Next If (f1 Is Nothing) Or (f2 Is Nothing) Then Exit Sub z1 = f1.PointOnFace.Z : z2 = f2.PointOnFace.Z If z1 >= z2 Then TagFace f1, "face_hi" : TagFace f2, "face_lo" Else TagFace f1, "face_lo" : TagFace f2, "face_hi" End If End Sub Sub TagFeatureFaces(oFeat, idx) On Error Resume Next If oFeat Is Nothing Then Exit Sub Dim f, topF, botF, zt, zb, z, n, cnt Set topF = Nothing : Set botF = Nothing : zt = -1E30 : zb = 1E30 : cnt = 0 For Each f In oFeat.Faces cnt = cnt + 1 z = f.PointOnFace.Z If z > zt Then zt = z : Set topF = f If z < zb Then zb = z : Set botF = f Next If cnt = 0 Then Exit Sub TagFace topF, "f" & idx & "_top" TagFace botF, "f" & idx & "_bot" n = 0 For Each f In oFeat.Faces If (Not (f Is topF)) And (Not (f Is botF)) Then TagFace f, "f" & idx & "_side" & n : n = n + 1 Next LogLine " [topo] f" & idx & ": " & cnt & " face(s) tagged" End Sub Sub TagClockAnchor(oFeat, idx, role, targetX, targetY) On Error Resume Next If oFeat Is Nothing Then Exit Sub If IsEmpty(gCylType) Then Exit Sub Dim f, c For Each f In oFeat.Faces If f.SurfaceType = gCylType Then Set c = f.Geometry.BasePoint If Abs(c.X - targetX) < 0.05 And Abs(c.Y - targetY) < 0.05 Then TagFace f, "clock_anchor" & role & "_f" & idx LogLine " [clock-tag] f" & idx & " anchor " & role & " at " & CLng(targetX*10) & "," & CLng(targetY*10) & " (0.1mm) stamped" Exit Sub End If End If Next LogLine " [warn] clock anchor " & role & " face not found for f" & idx End Sub Function FaceCircEdge(oFace, rCm, usedDict, keyPrefix) On Error Resume Next Dim e, c, k, skip Set FaceCircEdge = Nothing If oFace Is Nothing Then Exit Function If IsEmpty(gCircType) Then Exit Function For Each e In oFace.Edges If e.GeometryType = gCircType Then Set c = e.Geometry If Abs(c.Radius - rCm) < 0.12 Then k = keyPrefix & "|" & CLng(c.Center.X*100) & "," & CLng(c.Center.Y*100) skip = False If Not (usedDict Is Nothing) Then If usedDict.Exists(k) Then skip = True If Not skip Then If Not (usedDict Is Nothing) Then usedDict.Add k, True Set FaceCircEdge = e : Exit Function End If End If End If Next End Function Function FaceCircEdgeNearXY(oFace, px, py) On Error Resume Next Dim e, c, best, bestD, d Set best = Nothing : bestD = 1E30 If oFace Is Nothing Then Exit Function If IsEmpty(gCircType) Then Exit Function For Each e In oFace.Edges If e.GeometryType = gCircType Then Set c = e.Geometry d = (c.Center.X-px)^2 + (c.Center.Y-py)^2 If d 1E29) Then Exit Function Set best = Nothing : bestX = 1E30 : bestY = 1E30 For Each b In oOcc.SurfaceBodies For Each e In b.Edges If e.GeometryType = gCircType Then Set c = e.Geometry If (Abs(c.Radius - rCm) < 0.04) And (Abs(c.Center.Z - zRef) < 0.25) Then k = keyPrefix & "|" & CLng(c.Center.X*100) & "," & CLng(c.Center.Y*100) skip = False If Not (usedDict Is Nothing) Then If usedDict.Exists(k) Then skip = True If Not skip Then ' FIXED RULE — canonical order is min X, then min Y (left-to-right, bottom-up) If (c.Center.X < bestX - 0.01) Or ((Abs(c.Center.X - bestX) <= 0.01) And (c.Center.Y 1E29) Then Exit Function ' How far off-axis a hole may sit and still be THIS bolt's hole (cm). Generous enough for ' build tolerance, far tighter than the gap to a neighbouring hole on any real bolt circle. tolD = 0.5 * 0.5 For Each b In oOcc.SurfaceBodies For Each e In b.Edges If e.GeometryType = gCircType Then Set c = e.Geometry ' SAME tight radius test as BodyCircEdgeAtZ — a Ø6.6 bolt hole must never ' match a Ø45 central bore just because it happens to be the nearest circle. If (Abs(c.Radius - rCm) < 0.04) And (Abs(c.Center.Z - zRef) < 0.25) Then d = (c.Center.X-px)^2 + (c.Center.Y-py)^2 If (d < bestD) And (d <= tolD) Then bestD = d : Set best = e End If End If Next Next Set BodyCircEdgeAtZXY = best End Function Sub MateRoleFaces(oCons, occA, roleA, occB, roleB, tag) On Error Resume Next If (occA Is Nothing) Or (occB Is Nothing) Then Exit Sub Dim fa, fb Set fa = FaceByRole(occA, roleA) Set fb = FaceByRole(occB, roleB) If (fa Is Nothing) Or (fb Is Nothing) Then LogLine " [stack] " & tag & ": missing tagged face" : Exit Sub Err.Clear oCons.AddMateConstraint fa, fb, 0 If Err.Number = 0 Then LogLine " [stack] " & tag & ": ok" Else LogLine " [stack] " & tag & ": FAIL " & Err.Number & " " & Err.Description Err.Clear End If End Sub Function ResolveOccKey(dict, key) ResolveOccKey = "" If dict.Exists(key) Then ResolveOccKey = key : Exit Function Dim i, p, n, k i = InStrRev(key, ":") If i <= 0 Then Exit Function p = Left(key, i) n = CLng("0" & Mid(key, i + 1)) For k = n - 1 To 1 Step -1 If dict.Exists(p & k) Then ResolveOccKey = p & k : Exit Function Next End Function Sub MateByKeyRole(oCons, dict, occA, roleA, occB, roleB, offCm, opposed, tag) On Error Resume Next occA = ResolveOccKey(dict, occA) : occB = ResolveOccKey(dict, occB) If (occA = "") Or (occB = "") Then LogLine " [mate] " & tag & ": missing occ" : Exit Sub Dim fa, fb Set fa = FaceByRole(dict.Item(occA), roleA) Set fb = FaceByRole(dict.Item(occB), roleB) If (fa Is Nothing) Or (fb Is Nothing) Then LogLine " [mate] " & tag & ": face role not found (" & roleA & "," & roleB & ")" : Exit Sub Err.Clear If opposed Then oCons.AddMateConstraint fa, fb, offCm Else oCons.AddFlushConstraint fa, fb, offCm If Err.Number = 0 Then LogLine " [mate] " & tag & ": ok" Else LogLine " [mate] " & tag & ": FAIL " & Err.Number & " " & Err.Description End Sub Sub ConcentricById(oCons, dict, baseKey, childKey, rBaseCm, rChildCm, tag) On Error Resume Next If (Not dict.Exists(baseKey)) Or (Not dict.Exists(childKey)) Then LogLine " [concentric] " & tag & ": missing occ" : Exit Sub Concentric oCons, dict.Item(baseKey), dict.Item(childKey), rChildCm, rBaseCm, tag End Sub Sub CentreDistById(oCons, dict, aKey, bKey, rACm, rBCm, dCm, axisIdx, tag) On Error Resume Next If (Not dict.Exists(aKey)) Or (Not dict.Exists(bKey)) Then LogLine " [centre-dist] " & tag & ": missing occ" : Exit Sub If dCm <= 0 Then LogLine " [CENTRE-DIST-SKIP] " & tag & ": refused — a 0 mm separation would hold the mesh COAXIAL" : Exit Sub Dim eA, eB Set eA = CylFaceNearR(dict.Item(aKey), rACm) Set eB = CylFaceNearR(dict.Item(bKey), rBCm) If (Not (eA Is Nothing)) And (Not (eB Is Nothing)) Then Err.Clear oCons.AddMateConstraint eA, eB, dCm If Err.Number = 0 Then LogLine " [centre-dist] " & tag & ": axes parallel at " & Round(dCm * 10, 3) & " mm (bore cylinders)" : Exit Sub LogLine " [centre-dist] " & tag & ": cylinder mate FAIL " & Err.Number & " " & Err.Description & " — falling back to the origin work axes" Err.Clear Else LogLine " [centre-dist] " & tag & ": no bore cylinder at r " & Round(rACm * 10, 2) & "/" & Round(rBCm * 10, 2) & " mm — falling back to the origin work axes" End If Set eA = OriginProxy(dict.Item(aKey), False, axisIdx) Set eB = OriginProxy(dict.Item(bKey), False, axisIdx) If (eA Is Nothing) Or (eB Is Nothing) Then LogLine " [CENTRE-DIST-FAIL] " & tag & ": no bore cylinder AND no origin work axis — the " & Round(dCm * 10, 3) & " mm centre distance is NOT held" : Exit Sub Err.Clear oCons.AddMateConstraint eA, eB, dCm If Err.Number = 0 Then LogLine " [centre-dist] " & tag & ": axes parallel at " & Round(dCm * 10, 3) & " mm (origin work axis " & axisIdx & ")" Else LogLine " [CENTRE-DIST-FAIL] " & tag & ": FAIL " & Err.Number & " " & Err.Description & " — the " & Round(dCm * 10, 3) & " mm centre distance is NOT held" Err.Clear End If End Sub Sub CentreDistCheck(dict, aKey, bKey, dMm, tag) On Error Resume Next If (Not dict.Exists(aKey)) Or (Not dict.Exists(bKey)) Then Exit Sub Dim tA, tB, sx, sy, sz, act Set tA = dict.Item(aKey).Transformation.Translation Set tB = dict.Item(bKey).Transformation.Translation If (tA Is Nothing) Or (tB Is Nothing) Then Err.Clear : Exit Sub sx = (tB.X - tA.X) * 10 : sy = (tB.Y - tA.Y) * 10 : sz = (tB.Z - tA.Z) * 10 act = Sqr(sx * sx + sy * sy + sz * sz) LogLine " [CENTRE-DIST] " & tag & ": intended " & Round(dMm, 3) & " mm actual " & Round(act, 3) & " mm gap " & Round(Abs(act - dMm), 3) & " mm (delta " & Round(sx, 2) & "," & Round(sy, 2) & "," & Round(sz, 2) & ")" Err.Clear End Sub Function CircEdgeNearR(oOcc, rCm, wantTop, usedDict, keyPrefix, tolCm) On Error Resume Next Dim b, e, best, bestZ, c, k, bestKey, skip Set best = Nothing If IsEmpty(gCircType) Then Exit Function If wantTop Then bestZ = -1E30 Else bestZ = 1E30 For Each b In oOcc.SurfaceBodies For Each e In b.Edges If e.GeometryType = gCircType Then Set c = e.Geometry If Abs(c.Radius - rCm) bestZ Then bestZ = c.Center.Z : Set best = e : bestKey = k Else If c.Center.Z < bestZ Then bestZ = c.Center.Z : Set best = e : bestKey = k End If End If End If End If Next Next If (Not best Is Nothing) And (Not (usedDict Is Nothing)) Then usedDict.Add bestKey, True Set CircEdgeNearR = best End Function Function MinD(a, b) If a b Then MaxD = a Else MaxD = b End Function Function CircEdgeNearZ(oOcc, rCm, zCm, tolCm) On Error Resume Next Dim b, e, c, best, bestD Set best = Nothing : bestD = 1E30 If IsEmpty(gCircType) Then Exit Function For Each b In oOcc.SurfaceBodies For Each e In b.Edges If e.GeometryType = gCircType Then Set c = e.Geometry If Abs(c.Radius - rCm) < tolCm Then If Abs(c.Center.Z - zCm) -9999 Then Set eMal = CircEdgeNearZ(dict.Item(malKey), rMalCm, intendedZcm, 0.04) Else Set eMal = CircEdgeNearR(dict.Item(malKey), rMalCm, False, Nothing, "", 0.04) End If If (eHole Is Nothing) Or (eMal Is Nothing) Then LogLine " [insert] " & tag & ": no circular edge — fallback concentric" If intendedZcm > -9999 Then LogLine " [SEAT-GAP] " & tag & ": seated Z=none intended Z=" & Round(intendedZcm*10, 2) & " gap=9999" Concentric oCons, dict.Item(holeKey), dict.Item(malKey), rMalCm, rHoleCm, tag Exit Sub End If Err.Clear oCons.AddInsertConstraint eMal, eHole, axesOpp, 0 If Err.Number = 0 Then LogLine " [insert] " & tag & ": inserted (" & mode & ")" If Not gInserts Is Nothing Then If Not gInserts.Exists(holeKey & "|" & malKey) Then gInserts.Add holeKey & "|" & malKey, oCons.Item(oCons.Count) gInserts.Add malKey & "|" & holeKey, oCons.Item(oCons.Count) gInsertTags.Add holeKey & "|" & malKey, tag gInsertTags.Add malKey & "|" & holeKey, tag End If End If If intendedZcm > -9999 Then LogLine " [SEAT-GAP] " & tag & ": seated Z=" & Round(eMal.Geometry.Center.Z*10, 2) & " intended Z=" & Round(intendedZcm*10, 2) & " gap=" & Round(Abs(eMal.Geometry.Center.Z - intendedZcm)*10, 2) Else LogLine " [insert] " & tag & ": FAIL " & Err.Number & " " & Err.Description & " — fallback concentric" If intendedZcm > -9999 Then LogLine " [SEAT-GAP] " & tag & ": seated Z=none intended Z=" & Round(intendedZcm*10, 2) & " gap=9999" Err.Clear Concentric oCons, dict.Item(holeKey), dict.Item(malKey), rMalCm, rHoleCm, tag End If End Sub Function CircEdgeNearestXY(oOcc, rCm, px, py, pz, usedDict, keyPrefix) On Error Resume Next Dim b, e, best, bestD, c, k, bestKey, d, skip Set best = Nothing : bestD = 1E30 If IsEmpty(gCircType) Then Exit Function For Each b In oOcc.SurfaceBodies For Each e In b.Edges If e.GeometryType = gCircType Then Set c = e.Geometry If Abs(c.Radius - rCm) < 0.06 + rCm * 0.12 Then k = keyPrefix & "|" & CLng(c.Center.X*100) & "," & CLng(c.Center.Y*100) & "," & CLng(c.Center.Z*100) skip = False If Not (usedDict Is Nothing) Then If usedDict.Exists(k) Then skip = True If Not skip Then d = (c.Center.X-px)^2 + (c.Center.Y-py)^2 + (c.Center.Z-pz)^2 If d < bestD Then bestD = d : Set best = e : bestKey = k End If End If End If Next Next If (Not best Is Nothing) And (Not (usedDict Is Nothing)) Then usedDict.Add bestKey, True Set CircEdgeNearestXY = best End Function Function CircEdgeOppositeLarge(oOcc, px, py, pz, maxDistCm, usedDict, keyPrefix) On Error Resume Next Dim b, e, best, bestScore, c, k, bestKey, d, sc, skip Set best = Nothing : bestScore = -1 If IsEmpty(gCircType) Then Exit Function For Each b In oOcc.SurfaceBodies For Each e In b.Edges If e.GeometryType = gCircType Then Set c = e.Geometry d = Sqr((c.Center.X-px)^2 + (c.Center.Y-py)^2 + (c.Center.Z-pz)^2) If d bestScore) Then bestScore = sc : Set best = e : bestKey = k End If End If Next Next If (Not best Is Nothing) And (Not (usedDict Is Nothing)) Then usedDict.Add bestKey, True Set CircEdgeOppositeLarge = best End Function Sub DoInsert(oCons, e1, e2, tag) On Error Resume Next If (e1 Is Nothing) Or (e2 Is Nothing) Then LogLine " [stack] " & tag & ": missing edge" : Exit Sub Err.Clear oCons.AddInsertConstraint e1, e2, True, 0 If Err.Number = 0 Then LogLine " [stack] " & tag & ": ok" Else LogLine " [stack] " & tag & ": FAIL " & Err.Number & " " & Err.Description Err.Clear End If End Sub Sub FastenerStack(oCons, dict, plateKey, boltKey, washerKey, nutKey, rHole, rBolt, rWasher, rNut, tag) On Error Resume Next If Not dict.Exists(plateKey) Then Exit Sub If Not dict.Exists(boltKey) Then Exit Sub Dim oPlate, zBack, zFront, eHoleBack, eHoleFront, eBolt, eWash, eNut, c, px, py Set oPlate = dict.Item(plateKey) zBack = FaceRefZ(oPlate, "f0_bot") zFront = FaceRefZ(oPlate, "f0_top") ' BOLT: under-head rim INSERTED into a body hole rim on the BACK face (one atomic Insert) Set eHoleBack = BodyCircEdgeAtZ(oPlate, rHole, zBack, gUsed, plateKey) If eHoleBack Is Nothing Then LogLine " [stack] " & tag & ": no body hole on back (zBack=" & zBack & ")" : Exit Sub Set c = eHoleBack.Geometry.Center : px = c.X : py = c.Y Set eBolt = BodyCircEdgeAtZ(dict.Item(boltKey), rBolt, FaceRefZ(dict.Item(boltKey), "f0_top"), Nothing, "") DoInsert oCons, eBolt, eHoleBack, tag & " bolt->back" ' WASHER: bore rim INSERTED onto the SAME hole's rim on the FRONT face (opposite the head) If dict.Exists(washerKey) Then Set eHoleFront = BodyCircEdgeAtZXY(oPlate, rHole, zFront, px, py) Set eWash = BodyCircEdgeAtZ(dict.Item(washerKey), rWasher, FaceRefZ(dict.Item(washerKey), "f0_bot"), Nothing, "") DoInsert oCons, eWash, eHoleFront, tag & " washer->front" End If ' NUT: bore rim INSERTED onto the washer's OUTER rim (or the plate front if no washer) If dict.Exists(nutKey) Then Set eNut = BodyCircEdgeAtZ(dict.Item(nutKey), rNut, FaceRefZ(dict.Item(nutKey), "f0_bot"), Nothing, "") If dict.Exists(washerKey) Then DoInsert oCons, eNut, BodyCircEdgeAtZ(dict.Item(washerKey), rWasher, FaceRefZ(dict.Item(washerKey), "f0_top"), Nothing, ""), tag & " nut->washer" Else DoInsert oCons, eNut, BodyCircEdgeAtZXY(oPlate, rHole, zFront, px, py), tag & " nut->front" End If End If End Sub Sub BoltThroughStack(oCons, dict, firstKey, firstOuter, lastKey, lastOuter, boltKey, washerKey, headWasherKey, nutKey, rHole, rBolt, rWasher, rNut, tag) On Error Resume Next If (Not dict.Exists(firstKey)) Or (Not dict.Exists(boltKey)) Then LogLine " [skip] " & tag & ": stack member/bolt missing from this assembly" : Exit Sub Dim oFirst, oLast, zHead, eHead, c, px, py, zEnd, eEnd, eBolt, eWash, eHW, eNut Set oFirst = dict.Item(firstKey) If dict.Exists(lastKey) Then Set oLast = dict.Item(lastKey) Else Set oLast = oFirst ' BOLT HEAD -> the FIRST member's EXTERIOR-face hole (consumes it so each bolt takes its own) zHead = FaceRefZ(oFirst, firstOuter) Set eHead = BodyCircEdgeAtZ(oFirst, rHole, zHead, gUsed, firstKey) If eHead Is Nothing Then Dim altFirst : If firstOuter = "face_hi" Then altFirst = "face_lo" Else altFirst = "face_hi" Set eHead = BodyCircEdgeAtZ(oFirst, rHole, FaceRefZ(oFirst, altFirst), gUsed, firstKey) End If If eHead Is Nothing Then LogLine " [stack] " & tag & ": no entry hole" : Exit Sub Set c = eHead.Geometry.Center : px = c.X : py = c.Y ' HEAD-SIDE WASHER (ASME PCC-1: hardened flat washers under BOTH head and nut on a sealed ' joint). Inventory-driven: the occurrence exists only when the washer qty is 2 per bolt ' (the PCC-1 law set it) — a structural single-washer joint simply skips this block. If dict.Exists(headWasherKey) Then Set eHW = BodyCircEdgeAtZ(dict.Item(headWasherKey), rWasher, FaceRefZ(dict.Item(headWasherKey), "f0_bot"), Nothing, "") DoInsert oCons, eHW, eHead, tag & " washer->entry" MateRoleFaces oCons, dict.Item(headWasherKey), "f0_bot", oFirst, firstOuter, tag & " head-washer-flush" End If Set eBolt = BodyCircEdgeAtZ(dict.Item(boltKey), rBolt, FaceRefZ(dict.Item(boltKey), "f0_top"), Nothing, "") DoInsert oCons, eBolt, eHead, tag & " bolt->entry" ' WASHER + NUT -> the LAST member's EXTERIOR-face hole on the SAME axis (px,py) zEnd = FaceRefZ(oLast, lastOuter) Set eEnd = BodyCircEdgeAtZXY(oLast, rHole, zEnd, px, py) If eEnd Is Nothing Then Dim altLast : If lastOuter = "face_hi" Then altLast = "face_lo" Else altLast = "face_hi" Set eEnd = BodyCircEdgeAtZXY(oLast, rHole, FaceRefZ(oLast, altLast), px, py) End If If eEnd Is Nothing Then LogLine " [stack] " & tag & ": no exit hole" : Exit Sub If dict.Exists(washerKey) Then Set eWash = BodyCircEdgeAtZ(dict.Item(washerKey), rWasher, FaceRefZ(dict.Item(washerKey), "f0_bot"), Nothing, "") DoInsert oCons, eWash, eEnd, tag & " washer->exit" ' WASHER FACE CONVENTION (empirical, from observed runs): the washer->exit insert places the ' washer with f0_bot OUTBOARD. Keep washer-flush on f0_bot — flushing f0_top EMBEDS the washer ' into the flange. The nut therefore seats on the outboard face = f0_bot (see nut->washer). MateRoleFaces oCons, dict.Item(washerKey), "f0_bot", oLast, lastOuter, tag & " washer-flush" End If If dict.Exists(nutKey) Then ' BUILD-ORDER FIX (per the observed root cause): the washer is FULLY placed above (onto the ' flange/bolt). Place the NUT INDEPENDENTLY on the bolt axis — insert it onto the SAME flange-2 ' exterior hole the washer used, mirroring the bolt head on flange-1 (which sits correctly). ' Coupling nut->washer made the nut inherit the washer's solved orientation and flip inboard; ' referencing the bolt-axis hole instead orients the nut the same way as the head (outboard). Set eNut = BodyCircEdgeAtZ(dict.Item(nutKey), rNut, FaceRefZ(dict.Item(nutKey), "f0_top"), Nothing, "") DoInsert oCons, eNut, eEnd, tag & " nut->exit" End If End Sub Sub BuildPart_1() ' GEAR-0001 On Error Resume Next Dim oDoc, oDef, oSk, oWP, oProf, oExtDef, oFeat, oAxis, p1, p2, pts, i, oEdges, oE, oEC, nApplied, oLnF, oLn Dim vCutB, vCutA, oCutSB Dim oColl, oPatDef, oPat, oSk2, oProf2, oWP2, oSections, oLoftDef, oPath, oSk3D, oSwDef Set oDoc = oApp.Documents.Add(12290, oApp.FileManager.GetTemplateFile(12290), True) Set oDef = oDoc.ComponentDefinition LogLine " [part] GEAR-0001 (5 feature(s))" Err.Clear LogLine " [map] FEAT_1_GearBody: extrude circle Ø50 deep 20" Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(3)) ' FEAT_1_GearBody Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 2.5) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_1_GearBody: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20481) SetExtent oExtDef, 2, "pos" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0001 / FEAT_1_GearBody (Extrude): " & Err.Number & " " & Err.Description If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 0 Err.Clear LogLine " [map] FEAT_2_Hub: extrude circle Ø28 deep 18" Err.Clear Set oWP = oDef.WorkPlanes.AddByPlaneAndOffset(oDef.WorkPlanes.Item(3), 2) ' FEAT_2_Hub oWP.Visible = False Set oSk = oDef.Sketches.Add(oWP) Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 1.4) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_2_Hub: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20481) SetExtent oExtDef, 1.8, "pos" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0001 / FEAT_2_Hub (Extrude): " & Err.Number & " " & Err.Description If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 1 Err.Clear LogLine " [map] FEAT_3_ToothSpace: extrude custom_path through [cut]" vCutB = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutB = vCutB + oCutSB.Volume(0.001) : Next Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(3)) ' FEAT_3_ToothSpace ReDim pts(31) Set pts(0) = oTG.CreatePoint2d(1.9324, 0.1401) Set pts(1) = oTG.CreatePoint2d(2.1088, 0.1529) Set pts(2) = oTG.CreatePoint2d(2.1112, 0.1531) Set pts(3) = oTG.CreatePoint2d(2.1185, 0.1542) Set pts(4) = oTG.CreatePoint2d(2.1305, 0.1566) Set pts(5) = oTG.CreatePoint2d(2.1472, 0.1607) Set pts(6) = oTG.CreatePoint2d(2.1683, 0.167) Set pts(7) = oTG.CreatePoint2d(2.1938, 0.1759) Set pts(8) = oTG.CreatePoint2d(2.2233, 0.1879) Set pts(9) = oTG.CreatePoint2d(2.2567, 0.2034) Set pts(10) = oTG.CreatePoint2d(2.2936, 0.2227) Set pts(11) = oTG.CreatePoint2d(2.3338, 0.2463) Set pts(12) = oTG.CreatePoint2d(2.3769, 0.2744) Set pts(13) = oTG.CreatePoint2d(2.4226, 0.3075) Set pts(14) = oTG.CreatePoint2d(2.4704, 0.3458) Set pts(15) = oTG.CreatePoint2d(2.5201, 0.3896) Set pts(16) = oTG.CreatePoint2d(2.5201, -0.3896) Set pts(17) = oTG.CreatePoint2d(2.4704, -0.3458) Set pts(18) = oTG.CreatePoint2d(2.4226, -0.3075) Set pts(19) = oTG.CreatePoint2d(2.3769, -0.2744) Set pts(20) = oTG.CreatePoint2d(2.3338, -0.2463) Set pts(21) = oTG.CreatePoint2d(2.2936, -0.2227) Set pts(22) = oTG.CreatePoint2d(2.2567, -0.2034) Set pts(23) = oTG.CreatePoint2d(2.2233, -0.1879) Set pts(24) = oTG.CreatePoint2d(2.1938, -0.1759) Set pts(25) = oTG.CreatePoint2d(2.1683, -0.167) Set pts(26) = oTG.CreatePoint2d(2.1472, -0.1607) Set pts(27) = oTG.CreatePoint2d(2.1305, -0.1566) Set pts(28) = oTG.CreatePoint2d(2.1185, -0.1542) Set pts(29) = oTG.CreatePoint2d(2.1112, -0.1531) Set pts(30) = oTG.CreatePoint2d(2.1088, -0.1529) Set pts(31) = oTG.CreatePoint2d(1.9324, -0.1401) Set oLnF = oSk.SketchLines.AddByTwoPoints(pts(0), pts(1)) Set oLn = oLnF For i = 2 To 31 Set oLn = oSk.SketchLines.AddByTwoPoints(oLn.EndSketchPoint, pts(i)) Next Call oSk.SketchLines.AddByTwoPoints(oLn.EndSketchPoint, oLnF.StartSketchPoint) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_3_ToothSpace: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20482) SetExtent oExtDef, 12.5, "sym" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0001 / FEAT_3_ToothSpace (Extrude): " & Err.Number & " " & Err.Description Err.Clear If oDef.Features.Count > 0 Then Set oColl = oApp.TransientObjects.CreateObjectCollection oColl.Add oDef.Features.Item(oDef.Features.Count) Set oAxis = oDef.WorkAxes.Item(3) Set oPatDef = oDef.Features.CircularPatternFeatures.CreateDefinition(oColl, oAxis, True, 18, 6.2831853071796, True) Set oPat = oDef.Features.CircularPatternFeatures.AddByDefinition(oPatDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0001 / FEAT_3_ToothSpace (CircularPattern): " & Err.Number & " " & Err.Description Else LogLine " [pattern] FEAT_3_ToothSpace: 18x about axis 3" End If Err.Clear vCutA = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutA = vCutA + oCutSB.Volume(0.001) : Next If vCutB > 0 And (vCutB - vCutA) 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 2 Err.Clear LogLine " [map] FEAT_4_Bore_Pattern: hole Ø22.5 through [cut] x1" vCutB = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutB = vCutB + oCutSB.Volume(0.001) : Next Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(3)) ' FEAT_4_Bore_Pattern Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 1.125) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_4_Bore_Pattern: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20482) SetExtent oExtDef, 12.5, "sym" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0001 / FEAT_4_Bore_Pattern (Hole): " & Err.Number & " " & Err.Description vCutA = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutA = vCutA + oCutSB.Volume(0.001) : Next If vCutB > 0 And (vCutB - vCutA) 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 3 Err.Clear LogLine " [map] FEAT_5_Ktrootradius_Fillet: fillet" Err.Clear ' FEAT_5_Ktrootradius_Fillet (Fillet) — ALL edges in ONE feature (no per-edge explosion) Set oEC = oApp.TransientObjects.CreateEdgeCollection For Each oE In AllEdges(oDef) oEC.Add oE Next nApplied = oEC.Count Err.Clear If oEC.Count > 0 Then oDef.Features.FilletFeatures.AddSimple oEC, 0.28 If Err.Number 0 Then nApplied = 0 Err.Clear LogLine " [fillet] FEAT_5_Ktrootradius_Fillet -> " & nApplied & " edge(s) in 1 feature" If Err.Number 0 Then LogLine " [FAIL] GEAR-0001 / FEAT_5_Ktrootradius_Fillet (Fillet): " & Err.Number & " " & Err.Description oDoc.Update If oDef.SurfaceBodies.Count = 0 Then LogLine " [EMPTY] GEAR-0001 produced no solid body" If oDef.SurfaceBodies.Count > 1 Then LogLine " [MULTIBODY] GEAR-0001: " & oDef.SurfaceBodies.Count & " disconnected bodies" Dim hf, sickN, firstHS : sickN = 0 : firstHS = 0 For Each hf In oDef.Features If hf.HealthStatus 11778 And hf.HealthStatus 11783 Then sickN = sickN + 1 : If firstHS = 0 Then firstHS = hf.HealthStatus Next If sickN > 0 Then LogLine " [SICK] GEAR-0001: " & sickN & " feature(s) not healthy (HS=" & firstHS & ")" Dim rb, dxx, dyy, dzz, mxx Set rb = oDef.RangeBox If Not (rb Is Nothing) Then dxx = (rb.MaxPoint.X - rb.MinPoint.X) * 10 : dyy = (rb.MaxPoint.Y - rb.MinPoint.Y) * 10 : dzz = (rb.MaxPoint.Z - rb.MinPoint.Z) * 10 mxx = dxx : If dyy > mxx Then mxx = dyy If dzz > mxx Then mxx = dzz If mxx > 50000 Then LogLine " [OVERSIZE] GEAR-0001: " & Int(mxx) & " mm bounding box" End If TagBigFaces oDef If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(1), 0 SetMaterial oDoc, "Aluminium 6061-T6" Call oDoc.SaveAs(RootPath & "\GEAR-0001.ipt", False) oDoc.Close(True) End Sub Sub BuildPart_2() ' GEAR-0002 On Error Resume Next Dim oDoc, oDef, oSk, oWP, oProf, oExtDef, oFeat, oAxis, p1, p2, pts, i, oEdges, oE, oEC, nApplied, oLnF, oLn Dim vCutB, vCutA, oCutSB Dim oColl, oPatDef, oPat, oSk2, oProf2, oWP2, oSections, oLoftDef, oPath, oSk3D, oSwDef Set oDoc = oApp.Documents.Add(12290, oApp.FileManager.GetTemplateFile(12290), True) Set oDef = oDoc.ComponentDefinition LogLine " [part] GEAR-0002 (5 feature(s))" Err.Clear LogLine " [map] FEAT_1_GearBody: extrude circle Ø65 deep 20" Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(3)) ' FEAT_1_GearBody Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 3.25) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_1_GearBody: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20481) SetExtent oExtDef, 2, "pos" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0002 / FEAT_1_GearBody (Extrude): " & Err.Number & " " & Err.Description If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 0 Err.Clear LogLine " [map] FEAT_2_Hub: extrude circle Ø28 deep 18" Err.Clear Set oWP = oDef.WorkPlanes.AddByPlaneAndOffset(oDef.WorkPlanes.Item(3), 2) ' FEAT_2_Hub oWP.Visible = False Set oSk = oDef.Sketches.Add(oWP) Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 1.4) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_2_Hub: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20481) SetExtent oExtDef, 1.8, "pos" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0002 / FEAT_2_Hub (Extrude): " & Err.Number & " " & Err.Description If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 1 Err.Clear LogLine " [map] FEAT_3_ToothSpace: extrude custom_path through [cut]" vCutB = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutB = vCutB + oCutSB.Volume(0.001) : Next Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(3)) ' FEAT_3_ToothSpace ReDim pts(31) Set pts(0) = oTG.CreatePoint2d(2.6841, 0.1358) Set pts(1) = oTG.CreatePoint2d(2.8155, 0.1424) Set pts(2) = oTG.CreatePoint2d(2.8181, 0.1426) Set pts(3) = oTG.CreatePoint2d(2.8261, 0.1436) Set pts(4) = oTG.CreatePoint2d(2.8392, 0.1457) Set pts(5) = oTG.CreatePoint2d(2.8575, 0.1495) Set pts(6) = oTG.CreatePoint2d(2.8807, 0.1553) Set pts(7) = oTG.CreatePoint2d(2.9088, 0.1637) Set pts(8) = oTG.CreatePoint2d(2.9415, 0.1751) Set pts(9) = oTG.CreatePoint2d(2.9786, 0.1898) Set pts(10) = oTG.CreatePoint2d(3.0199, 0.2082) Set pts(11) = oTG.CreatePoint2d(3.0652, 0.2309) Set pts(12) = oTG.CreatePoint2d(3.1141, 0.258) Set pts(13) = oTG.CreatePoint2d(3.1662, 0.2901) Set pts(14) = oTG.CreatePoint2d(3.2214, 0.3274) Set pts(15) = oTG.CreatePoint2d(3.2792, 0.3702) Set pts(16) = oTG.CreatePoint2d(3.2792, -0.3702) Set pts(17) = oTG.CreatePoint2d(3.2214, -0.3274) Set pts(18) = oTG.CreatePoint2d(3.1662, -0.2901) Set pts(19) = oTG.CreatePoint2d(3.1141, -0.258) Set pts(20) = oTG.CreatePoint2d(3.0652, -0.2309) Set pts(21) = oTG.CreatePoint2d(3.0199, -0.2082) Set pts(22) = oTG.CreatePoint2d(2.9786, -0.1898) Set pts(23) = oTG.CreatePoint2d(2.9415, -0.1751) Set pts(24) = oTG.CreatePoint2d(2.9088, -0.1637) Set pts(25) = oTG.CreatePoint2d(2.8807, -0.1553) Set pts(26) = oTG.CreatePoint2d(2.8575, -0.1495) Set pts(27) = oTG.CreatePoint2d(2.8392, -0.1457) Set pts(28) = oTG.CreatePoint2d(2.8261, -0.1436) Set pts(29) = oTG.CreatePoint2d(2.8181, -0.1426) Set pts(30) = oTG.CreatePoint2d(2.8155, -0.1424) Set pts(31) = oTG.CreatePoint2d(2.6841, -0.1358) Set oLnF = oSk.SketchLines.AddByTwoPoints(pts(0), pts(1)) Set oLn = oLnF For i = 2 To 31 Set oLn = oSk.SketchLines.AddByTwoPoints(oLn.EndSketchPoint, pts(i)) Next Call oSk.SketchLines.AddByTwoPoints(oLn.EndSketchPoint, oLnF.StartSketchPoint) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_3_ToothSpace: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20482) SetExtent oExtDef, 16.25, "sym" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0002 / FEAT_3_ToothSpace (Extrude): " & Err.Number & " " & Err.Description Err.Clear If oDef.Features.Count > 0 Then Set oColl = oApp.TransientObjects.CreateObjectCollection oColl.Add oDef.Features.Item(oDef.Features.Count) Set oAxis = oDef.WorkAxes.Item(3) Set oPatDef = oDef.Features.CircularPatternFeatures.CreateDefinition(oColl, oAxis, True, 24, 6.2831853071796, True) Set oPat = oDef.Features.CircularPatternFeatures.AddByDefinition(oPatDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0002 / FEAT_3_ToothSpace (CircularPattern): " & Err.Number & " " & Err.Description Else LogLine " [pattern] FEAT_3_ToothSpace: 24x about axis 3" End If Err.Clear vCutA = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutA = vCutA + oCutSB.Volume(0.001) : Next If vCutB > 0 And (vCutB - vCutA) 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 2 Err.Clear LogLine " [map] FEAT_4_Bore_Pattern: hole Ø22.5 through [cut] x1" vCutB = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutB = vCutB + oCutSB.Volume(0.001) : Next Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(3)) ' FEAT_4_Bore_Pattern Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 1.125) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_4_Bore_Pattern: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20482) SetExtent oExtDef, 16.25, "sym" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0002 / FEAT_4_Bore_Pattern (Hole): " & Err.Number & " " & Err.Description vCutA = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutA = vCutA + oCutSB.Volume(0.001) : Next If vCutB > 0 And (vCutB - vCutA) 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 3 Err.Clear LogLine " [map] FEAT_5_Ktrootradius_Fillet: fillet" Err.Clear ' FEAT_5_Ktrootradius_Fillet (Fillet) — ALL edges in ONE feature (no per-edge explosion) Set oEC = oApp.TransientObjects.CreateEdgeCollection For Each oE In AllEdges(oDef) oEC.Add oE Next nApplied = oEC.Count Err.Clear If oEC.Count > 0 Then oDef.Features.FilletFeatures.AddSimple oEC, 0.28 If Err.Number 0 Then nApplied = 0 Err.Clear LogLine " [fillet] FEAT_5_Ktrootradius_Fillet -> " & nApplied & " edge(s) in 1 feature" If Err.Number 0 Then LogLine " [FAIL] GEAR-0002 / FEAT_5_Ktrootradius_Fillet (Fillet): " & Err.Number & " " & Err.Description oDoc.Update If oDef.SurfaceBodies.Count = 0 Then LogLine " [EMPTY] GEAR-0002 produced no solid body" If oDef.SurfaceBodies.Count > 1 Then LogLine " [MULTIBODY] GEAR-0002: " & oDef.SurfaceBodies.Count & " disconnected bodies" Dim hf, sickN, firstHS : sickN = 0 : firstHS = 0 For Each hf In oDef.Features If hf.HealthStatus 11778 And hf.HealthStatus 11783 Then sickN = sickN + 1 : If firstHS = 0 Then firstHS = hf.HealthStatus Next If sickN > 0 Then LogLine " [SICK] GEAR-0002: " & sickN & " feature(s) not healthy (HS=" & firstHS & ")" Dim rb, dxx, dyy, dzz, mxx Set rb = oDef.RangeBox If Not (rb Is Nothing) Then dxx = (rb.MaxPoint.X - rb.MinPoint.X) * 10 : dyy = (rb.MaxPoint.Y - rb.MinPoint.Y) * 10 : dzz = (rb.MaxPoint.Z - rb.MinPoint.Z) * 10 mxx = dxx : If dyy > mxx Then mxx = dyy If dzz > mxx Then mxx = dzz If mxx > 50000 Then LogLine " [OVERSIZE] GEAR-0002: " & Int(mxx) & " mm bounding box" End If TagBigFaces oDef If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(1), 0 SetMaterial oDoc, "Aluminium 6061-T6" Call oDoc.SaveAs(RootPath & "\GEAR-0002.ipt", False) oDoc.Close(True) End Sub Sub BuildPart_3() ' GEAR-0003 On Error Resume Next Dim oDoc, oDef, oSk, oWP, oProf, oExtDef, oFeat, oAxis, p1, p2, pts, i, oEdges, oE, oEC, nApplied, oLnF, oLn Dim vCutB, vCutA, oCutSB Dim oColl, oPatDef, oPat, oSk2, oProf2, oWP2, oSections, oLoftDef, oPath, oSk3D, oSwDef Set oDoc = oApp.Documents.Add(12290, oApp.FileManager.GetTemplateFile(12290), True) Set oDef = oDoc.ComponentDefinition LogLine " [part] GEAR-0003 (8 feature(s))" Err.Clear LogLine " [map] FEAT_1_Journal1bearingseat: extrude circle Ø20 deep 30" Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(3)) ' FEAT_1_Journal1bearingseat Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 1) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_1_Journal1bearingseat: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20481) SetExtent oExtDef, 3, "pos" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0003 / FEAT_1_Journal1bearingseat (Extrude): " & Err.Number & " " & Err.Description If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 0 Err.Clear LogLine " [map] FEAT_2_Journal2gearseat: extrude circle Ø22.5 deep 45" Err.Clear Set oWP = oDef.WorkPlanes.AddByPlaneAndOffset(oDef.WorkPlanes.Item(3), 3) ' FEAT_2_Journal2gearseat oWP.Visible = False Set oSk = oDef.Sketches.Add(oWP) Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 1.125) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_2_Journal2gearseat: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20481) SetExtent oExtDef, 4.5, "pos" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0003 / FEAT_2_Journal2gearseat (Extrude): " & Err.Number & " " & Err.Description If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 1 Err.Clear LogLine " [map] FEAT_3_Journal3bearingseat: extrude circle Ø35 deep 25" Err.Clear Set oWP = oDef.WorkPlanes.AddByPlaneAndOffset(oDef.WorkPlanes.Item(3), 7.5) ' FEAT_3_Journal3bearingseat oWP.Visible = False Set oSk = oDef.Sketches.Add(oWP) Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 1.75) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_3_Journal3bearingseat: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20481) SetExtent oExtDef, 2.5, "pos" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0003 / FEAT_3_Journal3bearingseat (Extrude): " & Err.Number & " " & Err.Description If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 2 Err.Clear LogLine " [map] FEAT_4_Journal4coupling: extrude circle Ø30 deep 20" Err.Clear Set oWP = oDef.WorkPlanes.AddByPlaneAndOffset(oDef.WorkPlanes.Item(3), 10) ' FEAT_4_Journal4coupling oWP.Visible = False Set oSk = oDef.Sketches.Add(oWP) Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 1.5) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_4_Journal4coupling: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20481) SetExtent oExtDef, 2, "pos" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0003 / FEAT_4_Journal4coupling (Extrude): " & Err.Number & " " & Err.Description If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 3 Err.Clear LogLine " [map] FEAT_5_Keyway: extrude rectangle 12x6 deep 36 [cut]" vCutB = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutB = vCutB + oCutSB.Volume(0.001) : Next Err.Clear Set oWP = oDef.WorkPlanes.AddByPlaneAndOffset(oDef.WorkPlanes.Item(3), 3.45) ' FEAT_5_Keyway oWP.Visible = False Set oSk = oDef.Sketches.Add(oWP) Set p1 = oTG.CreatePoint2d(-0.6, -0.3) Set p2 = oTG.CreatePoint2d(0.6, 0.3) Call oSk.SketchLines.AddAsTwoPointRectangle(p1, p2) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_5_Keyway: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20482) SetExtent oExtDef, 3.6, "pos" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0003 / FEAT_5_Keyway (Extrude): " & Err.Number & " " & Err.Description vCutA = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutA = vCutA + oCutSB.Volume(0.001) : Next If vCutB > 0 And (vCutB - vCutA) 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 4 Err.Clear LogLine " [map] FEAT_6_Keyway: extrude rectangle 10x4.3 deep 18 [cut]" vCutB = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutB = vCutB + oCutSB.Volume(0.001) : Next Err.Clear Set oWP = oDef.WorkPlanes.AddByPlaneAndOffset(oDef.WorkPlanes.Item(3), 10.1) ' FEAT_6_Keyway oWP.Visible = False Set oSk = oDef.Sketches.Add(oWP) Set p1 = oTG.CreatePoint2d(-0.5, 1.17) Set p2 = oTG.CreatePoint2d(0.5, 1.6) Call oSk.SketchLines.AddAsTwoPointRectangle(p1, p2) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_6_Keyway: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20482) SetExtent oExtDef, 1.8, "pos" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0003 / FEAT_6_Keyway (Extrude): " & Err.Number & " " & Err.Description vCutA = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutA = vCutA + oCutSB.Volume(0.001) : Next If vCutB > 0 And (vCutB - vCutA) 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 5 Err.Clear LogLine " [map] FEAT_7_Ktrootradius_Fillet: fillet" Err.Clear ' FEAT_7_Ktrootradius_Fillet (Fillet) — ALL edges in ONE feature (no per-edge explosion) Set oEC = oApp.TransientObjects.CreateEdgeCollection For Each oE In AllEdges(oDef) oEC.Add oE Next nApplied = oEC.Count Err.Clear If oEC.Count > 0 Then oDef.Features.FilletFeatures.AddSimple oEC, 0.062 If Err.Number 0 Then nApplied = 0 Err.Clear LogLine " [fillet] FEAT_7_Ktrootradius_Fillet -> " & nApplied & " edge(s) in 1 feature" If Err.Number 0 Then LogLine " [FAIL] GEAR-0003 / FEAT_7_Ktrootradius_Fillet (Fillet): " & Err.Number & " " & Err.Description Err.Clear LogLine " [map] FEAT_8_InheritedPassage_Pattern: hole Ø12 through [cut] x1" vCutB = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutB = vCutB + oCutSB.Volume(0.001) : Next Err.Clear Set oWP = oDef.WorkPlanes.AddByPlaneAndOffset(oDef.WorkPlanes.Item(3), 3) ' FEAT_8_InheritedPassage_Pattern oWP.Visible = False Set oSk = oDef.Sketches.Add(oWP) Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 0.6) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_8_InheritedPassage_Pattern: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20482) SetExtent oExtDef, 7.5, "sym" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0003 / FEAT_8_InheritedPassage_Pattern (Hole): " & Err.Number & " " & Err.Description vCutA = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutA = vCutA + oCutSB.Volume(0.001) : Next If vCutB > 0 And (vCutB - vCutA) 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 7 oDoc.Update If oDef.SurfaceBodies.Count = 0 Then LogLine " [EMPTY] GEAR-0003 produced no solid body" If oDef.SurfaceBodies.Count > 1 Then LogLine " [MULTIBODY] GEAR-0003: " & oDef.SurfaceBodies.Count & " disconnected bodies" Dim hf, sickN, firstHS : sickN = 0 : firstHS = 0 For Each hf In oDef.Features If hf.HealthStatus 11778 And hf.HealthStatus 11783 Then sickN = sickN + 1 : If firstHS = 0 Then firstHS = hf.HealthStatus Next If sickN > 0 Then LogLine " [SICK] GEAR-0003: " & sickN & " feature(s) not healthy (HS=" & firstHS & ")" Dim rb, dxx, dyy, dzz, mxx Set rb = oDef.RangeBox If Not (rb Is Nothing) Then dxx = (rb.MaxPoint.X - rb.MinPoint.X) * 10 : dyy = (rb.MaxPoint.Y - rb.MinPoint.Y) * 10 : dzz = (rb.MaxPoint.Z - rb.MinPoint.Z) * 10 mxx = dxx : If dyy > mxx Then mxx = dyy If dzz > mxx Then mxx = dzz If mxx > 50000 Then LogLine " [OVERSIZE] GEAR-0003: " & Int(mxx) & " mm bounding box" End If TagBigFaces oDef If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(1), 0 SetMaterial oDoc, "Stainless steel 304" Call oDoc.SaveAs(RootPath & "\GEAR-0003.ipt", False) oDoc.Close(True) End Sub Sub BuildPart_4() ' BRNG-0001 On Error Resume Next Dim oDoc, oDef, oSk, oWP, oProf, oExtDef, oFeat, oAxis, p1, p2, pts, i, oEdges, oE, oEC, nApplied, oLnF, oLn Dim vCutB, vCutA, oCutSB Dim oColl, oPatDef, oPat, oSk2, oProf2, oWP2, oSections, oLoftDef, oPath, oSk3D, oSwDef Set oDoc = oApp.Documents.Add(12290, oApp.FileManager.GetTemplateFile(12290), True) Set oDef = oDoc.ComponentDefinition LogLine " [part] BRNG-0001 (3 feature(s))" Err.Clear LogLine " [map] FEAT_1_Bearing: revolve custom_path" Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(2)) ' FEAT_1_Bearing Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(2)) ' revolve: profile coplanar with the Z (extrude) axis ReDim pts(11) Set pts(0) = oTG.CreatePoint2d(1, 0) Set pts(1) = oTG.CreatePoint2d(1.52, 0) Set pts(2) = oTG.CreatePoint2d(1.52, 0.345) Set pts(3) = oTG.CreatePoint2d(2.33, 0.345) Set pts(4) = oTG.CreatePoint2d(2.33, 0) Set pts(5) = oTG.CreatePoint2d(2.6, 0) Set pts(6) = oTG.CreatePoint2d(2.6, 1.5) Set pts(7) = oTG.CreatePoint2d(2.33, 1.5) Set pts(8) = oTG.CreatePoint2d(2.33, 1.155) Set pts(9) = oTG.CreatePoint2d(1.52, 1.155) Set pts(10) = oTG.CreatePoint2d(1.52, 1.5) Set pts(11) = oTG.CreatePoint2d(1, 1.5) Set oLnF = oSk.SketchLines.AddByTwoPoints(pts(0), pts(1)) ' chained loop → a genuinely closed region Set oLn = oLnF For i = 2 To 11 Set oLn = oSk.SketchLines.AddByTwoPoints(oLn.EndSketchPoint, pts(i)) Next Call oSk.SketchLines.AddByTwoPoints(oLn.EndSketchPoint, oLnF.StartSketchPoint) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_1_Bearing: revolve profile did not close (no region)" Set oAxis = oDef.WorkAxes.Item(3) Set oFeat = oDef.Features.RevolveFeatures.AddFull(oProf, oAxis, 20481) If Err.Number 0 Then LogLine " [FAIL] BRNG-0001 / FEAT_1_Bearing (Revolve): " & Err.Number & " " & Err.Description If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 0 Err.Clear LogLine " [map] FEAT_2_Linkageborealignpassage_Pattern: hole Ø17 through [cut] x1" vCutB = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutB = vCutB + oCutSB.Volume(0.001) : Next Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(3)) ' FEAT_2_Linkageborealignpassage_Pattern Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 0.85) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_2_Linkageborealignpassage_Pattern: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20482) SetExtent oExtDef, 2, "sym" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] BRNG-0001 / FEAT_2_Linkageborealignpassage_Pattern (Hole): " & Err.Number & " " & Err.Description vCutA = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutA = vCutA + oCutSB.Volume(0.001) : Next If vCutB > 0 And (vCutB - vCutA) 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 1 Err.Clear LogLine " [map] FEAT_3_Linkageborealignspigot_Pattern: hole Ø20 through [cut] x1" vCutB = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutB = vCutB + oCutSB.Volume(0.001) : Next Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(3)) ' FEAT_3_Linkageborealignspigot_Pattern Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 1) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_3_Linkageborealignspigot_Pattern: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20482) SetExtent oExtDef, 2, "sym" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] BRNG-0001 / FEAT_3_Linkageborealignspigot_Pattern (Hole): " & Err.Number & " " & Err.Description vCutA = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutA = vCutA + oCutSB.Volume(0.001) : Next If vCutB > 0 And (vCutB - vCutA) 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 2 oDoc.Update If oDef.SurfaceBodies.Count = 0 Then LogLine " [EMPTY] BRNG-0001 produced no solid body" If oDef.SurfaceBodies.Count > 1 Then LogLine " [MULTIBODY] BRNG-0001: " & oDef.SurfaceBodies.Count & " disconnected bodies" Dim hf, sickN, firstHS : sickN = 0 : firstHS = 0 For Each hf In oDef.Features If hf.HealthStatus 11778 And hf.HealthStatus 11783 Then sickN = sickN + 1 : If firstHS = 0 Then firstHS = hf.HealthStatus Next If sickN > 0 Then LogLine " [SICK] BRNG-0001: " & sickN & " feature(s) not healthy (HS=" & firstHS & ")" Dim rb, dxx, dyy, dzz, mxx Set rb = oDef.RangeBox If Not (rb Is Nothing) Then dxx = (rb.MaxPoint.X - rb.MinPoint.X) * 10 : dyy = (rb.MaxPoint.Y - rb.MinPoint.Y) * 10 : dzz = (rb.MaxPoint.Z - rb.MinPoint.Z) * 10 mxx = dxx : If dyy > mxx Then mxx = dyy If dzz > mxx Then mxx = dzz If mxx > 50000 Then LogLine " [OVERSIZE] BRNG-0001: " & Int(mxx) & " mm bounding box" End If TagBigFaces oDef If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(1), 0 SetMaterial oDoc, "Bearing steel 440C stainless bearing steel" Call oDoc.SaveAs(RootPath & "\BRNG-0001.ipt", False) oDoc.Close(True) End Sub Sub BuildPart_5() ' GEAR-0004 On Error Resume Next Dim oDoc, oDef, oSk, oWP, oProf, oExtDef, oFeat, oAxis, p1, p2, pts, i, oEdges, oE, oEC, nApplied, oLnF, oLn Dim vCutB, vCutA, oCutSB Dim oColl, oPatDef, oPat, oSk2, oProf2, oWP2, oSections, oLoftDef, oPath, oSk3D, oSwDef Set oDoc = oApp.Documents.Add(12290, oApp.FileManager.GetTemplateFile(12290), True) Set oDef = oDoc.ComponentDefinition LogLine " [part] GEAR-0004 (5 feature(s))" Err.Clear LogLine " [map] FEAT_1_Body: extrude circle Ø90 deep 36.5" Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(3)) ' FEAT_1_Body Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 4.5) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_1_Body: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20481) SetExtent oExtDef, 3.65, "pos" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0004 / FEAT_1_Body (Extrude): " & Err.Number & " " & Err.Description If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 0 Err.Clear LogLine " [map] FEAT_2_BearingSeat_Pattern: hole Ø20 through [cut] x1" vCutB = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutB = vCutB + oCutSB.Volume(0.001) : Next Err.Clear Set oWP = oDef.WorkPlanes.AddByPlaneAndOffset(oDef.WorkPlanes.Item(3), 3.65) ' FEAT_2_BearingSeat_Pattern oWP.Visible = False Set oSk = oDef.Sketches.Add(oWP) Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 1) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_2_BearingSeat_Pattern: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20482) SetExtent oExtDef, 22.5, "sym" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0004 / FEAT_2_BearingSeat_Pattern (Hole): " & Err.Number & " " & Err.Description vCutA = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutA = vCutA + oCutSB.Volume(0.001) : Next If vCutB > 0 And (vCutB - vCutA) 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 1 Err.Clear LogLine " [map] FEAT_3_Leadin_Chamfer: chamfer" Err.Clear ' FEAT_3_Leadin_Chamfer (Chamfer) — ALL edges in ONE feature (no per-edge explosion) Set oEC = oApp.TransientObjects.CreateEdgeCollection For Each oE In AllEdges(oDef) oEC.Add oE Next nApplied = oEC.Count Err.Clear If oEC.Count > 0 Then oDef.Features.ChamferFeatures.AddUsingDistance oEC, 0.1 If Err.Number 0 Then nApplied = 0 Err.Clear LogLine " [chamfer] FEAT_3_Leadin_Chamfer -> " & nApplied & " edge(s) in 1 feature" If Err.Number 0 Then LogLine " [FAIL] GEAR-0004 / FEAT_3_Leadin_Chamfer (Chamfer): " & Err.Number & " " & Err.Description Err.Clear LogLine " [map] FEAT_4_EdgeBreak_Fillet: fillet" Err.Clear ' FEAT_4_EdgeBreak_Fillet (Fillet) — ALL edges in ONE feature (no per-edge explosion) Set oEC = oApp.TransientObjects.CreateEdgeCollection For Each oE In AllEdges(oDef) oEC.Add oE Next nApplied = oEC.Count Err.Clear If oEC.Count > 0 Then oDef.Features.FilletFeatures.AddSimple oEC, 0.1 If Err.Number 0 Then nApplied = 0 Err.Clear LogLine " [fillet] FEAT_4_EdgeBreak_Fillet -> " & nApplied & " edge(s) in 1 feature" If Err.Number 0 Then LogLine " [FAIL] GEAR-0004 / FEAT_4_EdgeBreak_Fillet (Fillet): " & Err.Number & " " & Err.Description Err.Clear LogLine " [map] FEAT_5_MountingHoles_Pattern: hole Ø5.5 through [cut] x4" vCutB = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutB = vCutB + oCutSB.Volume(0.001) : Next Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(3)) ' FEAT_5_MountingHoles_Pattern Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, -2.875), 0.275) Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(2.875, 0), 0.275) Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 2.875), 0.275) Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(-2.875, 0), 0.275) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_5_MountingHoles_Pattern: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20482) SetExtent oExtDef, 22.5, "sym" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] GEAR-0004 / FEAT_5_MountingHoles_Pattern (Hole): " & Err.Number & " " & Err.Description vCutA = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutA = vCutA + oCutSB.Volume(0.001) : Next If vCutB > 0 And (vCutB - vCutA) 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 4 If oDef.Features.Count > 0 Then TagClockAnchor oDef.Features.Item(oDef.Features.Count), 4, "A", -2.875, 0 If oDef.Features.Count > 0 Then TagClockAnchor oDef.Features.Item(oDef.Features.Count), 4, "B", 2.875, 0 oDoc.Update If oDef.SurfaceBodies.Count = 0 Then LogLine " [EMPTY] GEAR-0004 produced no solid body" If oDef.SurfaceBodies.Count > 1 Then LogLine " [MULTIBODY] GEAR-0004: " & oDef.SurfaceBodies.Count & " disconnected bodies" Dim hf, sickN, firstHS : sickN = 0 : firstHS = 0 For Each hf In oDef.Features If hf.HealthStatus 11778 And hf.HealthStatus 11783 Then sickN = sickN + 1 : If firstHS = 0 Then firstHS = hf.HealthStatus Next If sickN > 0 Then LogLine " [SICK] GEAR-0004: " & sickN & " feature(s) not healthy (HS=" & firstHS & ")" Dim rb, dxx, dyy, dzz, mxx Set rb = oDef.RangeBox If Not (rb Is Nothing) Then dxx = (rb.MaxPoint.X - rb.MinPoint.X) * 10 : dyy = (rb.MaxPoint.Y - rb.MinPoint.Y) * 10 : dzz = (rb.MaxPoint.Z - rb.MinPoint.Z) * 10 mxx = dxx : If dyy > mxx Then mxx = dyy If dzz > mxx Then mxx = dzz If mxx > 50000 Then LogLine " [OVERSIZE] GEAR-0004: " & Int(mxx) & " mm bounding box" End If TagBigFaces oDef If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(1), 0 SetMaterial oDoc, "Aluminium 6061-T6" Call oDoc.SaveAs(RootPath & "\GEAR-0004.ipt", False) oDoc.Close(True) End Sub Sub BuildPart_6() ' MOUN-0001 On Error Resume Next Dim oDoc, oDef, oSk, oWP, oProf, oExtDef, oFeat, oAxis, p1, p2, pts, i, oEdges, oE, oEC, nApplied, oLnF, oLn Dim vCutB, vCutA, oCutSB Dim oColl, oPatDef, oPat, oSk2, oProf2, oWP2, oSections, oLoftDef, oPath, oSk3D, oSwDef Set oDoc = oApp.Documents.Add(12290, oApp.FileManager.GetTemplateFile(12290), True) Set oDef = oDoc.ComponentDefinition LogLine " [part] MOUN-0001 (4 feature(s))" Err.Clear LogLine " [map] FEAT_1_Body: extrude rectangle 90x90 deep 5" Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(3)) ' FEAT_1_Body Set p1 = oTG.CreatePoint2d(-4.5, -4.5) Set p2 = oTG.CreatePoint2d(4.5, 4.5) Call oSk.SketchLines.AddAsTwoPointRectangle(p1, p2) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_1_Body: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20481) SetExtent oExtDef, 0.5, "pos" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] MOUN-0001 / FEAT_1_Body (Extrude): " & Err.Number & " " & Err.Description If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 0 Err.Clear LogLine " [map] FEAT_2_CentralBore_Pattern: hole Ø25 through [cut] x1" vCutB = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutB = vCutB + oCutSB.Volume(0.001) : Next Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(3)) ' FEAT_2_CentralBore_Pattern Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 1.25) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_2_CentralBore_Pattern: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20482) SetExtent oExtDef, 22.5, "sym" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] MOUN-0001 / FEAT_2_CentralBore_Pattern (Hole): " & Err.Number & " " & Err.Description vCutA = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutA = vCutA + oCutSB.Volume(0.001) : Next If vCutB > 0 And (vCutB - vCutA) 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 1 Err.Clear LogLine " [map] FEAT_3_CornerRelief_Fillet: fillet" Err.Clear ' FEAT_3_CornerRelief_Fillet (Fillet) — ALL edges in ONE feature (no per-edge explosion) Set oEC = oApp.TransientObjects.CreateEdgeCollection For Each oE In AllEdges(oDef) oEC.Add oE Next nApplied = oEC.Count Err.Clear If oEC.Count > 0 Then oDef.Features.FilletFeatures.AddSimple oEC, 0.6 If Err.Number 0 Then nApplied = 0 Err.Clear LogLine " [fillet] FEAT_3_CornerRelief_Fillet -> " & nApplied & " edge(s) in 1 feature" If Err.Number 0 Then LogLine " [FAIL] MOUN-0001 / FEAT_3_CornerRelief_Fillet (Fillet): " & Err.Number & " " & Err.Description Err.Clear LogLine " [map] FEAT_4_MountingHoles_Pattern: hole Ø5.5 through [cut] x4" vCutB = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutB = vCutB + oCutSB.Volume(0.001) : Next Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(3)) ' FEAT_4_MountingHoles_Pattern Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, -2.875), 0.275) Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(2.875, 0), 0.275) Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 2.875), 0.275) Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(-2.875, 0), 0.275) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_4_MountingHoles_Pattern: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20482) SetExtent oExtDef, 22.5, "sym" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] MOUN-0001 / FEAT_4_MountingHoles_Pattern (Hole): " & Err.Number & " " & Err.Description vCutA = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutA = vCutA + oCutSB.Volume(0.001) : Next If vCutB > 0 And (vCutB - vCutA) 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 3 If oDef.Features.Count > 0 Then TagClockAnchor oDef.Features.Item(oDef.Features.Count), 3, "A", -2.875, 0 If oDef.Features.Count > 0 Then TagClockAnchor oDef.Features.Item(oDef.Features.Count), 3, "B", 2.875, 0 oDoc.Update If oDef.SurfaceBodies.Count = 0 Then LogLine " [EMPTY] MOUN-0001 produced no solid body" If oDef.SurfaceBodies.Count > 1 Then LogLine " [MULTIBODY] MOUN-0001: " & oDef.SurfaceBodies.Count & " disconnected bodies" Dim hf, sickN, firstHS : sickN = 0 : firstHS = 0 For Each hf In oDef.Features If hf.HealthStatus 11778 And hf.HealthStatus 11783 Then sickN = sickN + 1 : If firstHS = 0 Then firstHS = hf.HealthStatus Next If sickN > 0 Then LogLine " [SICK] MOUN-0001: " & sickN & " feature(s) not healthy (HS=" & firstHS & ")" Dim rb, dxx, dyy, dzz, mxx Set rb = oDef.RangeBox If Not (rb Is Nothing) Then dxx = (rb.MaxPoint.X - rb.MinPoint.X) * 10 : dyy = (rb.MaxPoint.Y - rb.MinPoint.Y) * 10 : dzz = (rb.MaxPoint.Z - rb.MinPoint.Z) * 10 mxx = dxx : If dyy > mxx Then mxx = dyy If dzz > mxx Then mxx = dzz If mxx > 50000 Then LogLine " [OVERSIZE] MOUN-0001: " & Int(mxx) & " mm bounding box" End If TagBigFaces oDef If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(1), 0 SetMaterial oDoc, "Aluminium 6061-T6" Call oDoc.SaveAs(RootPath & "\MOUN-0001.ipt", False) oDoc.Close(True) End Sub Sub BuildPart_7() ' SCRW-0001 On Error Resume Next Dim oDoc, oDef, oSk, oWP, oProf, oExtDef, oFeat, oAxis, p1, p2, pts, i, oEdges, oE, oEC, nApplied, oLnF, oLn Dim vCutB, vCutA, oCutSB Dim oColl, oPatDef, oPat, oSk2, oProf2, oWP2, oSections, oLoftDef, oPath, oSk3D, oSwDef Set oDoc = oApp.Documents.Add(12290, oApp.FileManager.GetTemplateFile(12290), True) Set oDef = oDoc.ComponentDefinition LogLine " [part] SCRW-0001 (3 feature(s))" Err.Clear LogLine " [map] FEAT_1_Head: extrude polygon deep 3.5" Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(3)) ' FEAT_1_Head ReDim pts(5) Set pts(0) = oTG.CreatePoint2d(0.4, 0.2309) Set pts(1) = oTG.CreatePoint2d(0, 0.4619) Set pts(2) = oTG.CreatePoint2d(-0.4, 0.2309) Set pts(3) = oTG.CreatePoint2d(-0.4, -0.2309) Set pts(4) = oTG.CreatePoint2d(0, -0.4619) Set pts(5) = oTG.CreatePoint2d(0.4, -0.2309) Set oLnF = oSk.SketchLines.AddByTwoPoints(pts(0), pts(1)) Set oLn = oLnF For i = 2 To 5 Set oLn = oSk.SketchLines.AddByTwoPoints(oLn.EndSketchPoint, pts(i)) Next Call oSk.SketchLines.AddByTwoPoints(oLn.EndSketchPoint, oLnF.StartSketchPoint) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_1_Head: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20481) SetExtent oExtDef, 0.35, "pos" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] SCRW-0001 / FEAT_1_Head (Extrude): " & Err.Number & " " & Err.Description If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 0 Err.Clear LogLine " [map] FEAT_2_Shank: extrude circle Ø5 deep 105" Err.Clear Set oWP = oDef.WorkPlanes.AddByPlaneAndOffset(oDef.WorkPlanes.Item(3), 0.35) ' FEAT_2_Shank oWP.Visible = False Set oSk = oDef.Sketches.Add(oWP) Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 0.25) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_2_Shank: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20481) SetExtent oExtDef, 10.5, "pos" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] SCRW-0001 / FEAT_2_Shank (Extrude): " & Err.Number & " " & Err.Description If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 1 Err.Clear LogLine " [map] FEAT_3_Leadin_Chamfer: chamfer" Err.Clear ' FEAT_3_Leadin_Chamfer (Chamfer) — ALL edges in ONE feature (no per-edge explosion) Set oEC = oApp.TransientObjects.CreateEdgeCollection For Each oE In AllEdges(oDef) oEC.Add oE Next nApplied = oEC.Count Err.Clear If oEC.Count > 0 Then oDef.Features.ChamferFeatures.AddUsingDistance oEC, 0.06 If Err.Number 0 Then nApplied = 0 Err.Clear LogLine " [chamfer] FEAT_3_Leadin_Chamfer -> " & nApplied & " edge(s) in 1 feature" If Err.Number 0 Then LogLine " [FAIL] SCRW-0001 / FEAT_3_Leadin_Chamfer (Chamfer): " & Err.Number & " " & Err.Description oDoc.Update If oDef.SurfaceBodies.Count = 0 Then LogLine " [EMPTY] SCRW-0001 produced no solid body" If oDef.SurfaceBodies.Count > 1 Then LogLine " [MULTIBODY] SCRW-0001: " & oDef.SurfaceBodies.Count & " disconnected bodies" Dim hf, sickN, firstHS : sickN = 0 : firstHS = 0 For Each hf In oDef.Features If hf.HealthStatus 11778 And hf.HealthStatus 11783 Then sickN = sickN + 1 : If firstHS = 0 Then firstHS = hf.HealthStatus Next If sickN > 0 Then LogLine " [SICK] SCRW-0001: " & sickN & " feature(s) not healthy (HS=" & firstHS & ")" Dim rb, dxx, dyy, dzz, mxx Set rb = oDef.RangeBox If Not (rb Is Nothing) Then dxx = (rb.MaxPoint.X - rb.MinPoint.X) * 10 : dyy = (rb.MaxPoint.Y - rb.MinPoint.Y) * 10 : dzz = (rb.MaxPoint.Z - rb.MinPoint.Z) * 10 mxx = dxx : If dyy > mxx Then mxx = dyy If dzz > mxx Then mxx = dzz If mxx > 50000 Then LogLine " [OVERSIZE] SCRW-0001: " & Int(mxx) & " mm bounding box" End If TagBigFaces oDef If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(1), 0 SetMaterial oDoc, "Stainless steel 304" Call oDoc.SaveAs(RootPath & "\SCRW-0001.ipt", False) oDoc.Close(True) End Sub Sub BuildPart_8() ' WASH-0001 On Error Resume Next Dim oDoc, oDef, oSk, oWP, oProf, oExtDef, oFeat, oAxis, p1, p2, pts, i, oEdges, oE, oEC, nApplied, oLnF, oLn Dim vCutB, vCutA, oCutSB Dim oColl, oPatDef, oPat, oSk2, oProf2, oWP2, oSections, oLoftDef, oPath, oSk3D, oSwDef Set oDoc = oApp.Documents.Add(12290, oApp.FileManager.GetTemplateFile(12290), True) Set oDef = oDoc.ComponentDefinition LogLine " [part] WASH-0001 (2 feature(s))" Err.Clear LogLine " [map] FEAT_1_Washer: extrude circle Ø10 deep 1" Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(3)) ' FEAT_1_Washer Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 0.5) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_1_Washer: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20481) SetExtent oExtDef, 0.1, "pos" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] WASH-0001 / FEAT_1_Washer (Extrude): " & Err.Number & " " & Err.Description If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 0 Err.Clear LogLine " [map] FEAT_2_Bore_Pattern: hole Ø5.5 through [cut] x1" vCutB = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutB = vCutB + oCutSB.Volume(0.001) : Next Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(3)) ' FEAT_2_Bore_Pattern Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 0.275) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_2_Bore_Pattern: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20482) SetExtent oExtDef, 2.5, "sym" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] WASH-0001 / FEAT_2_Bore_Pattern (Hole): " & Err.Number & " " & Err.Description vCutA = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutA = vCutA + oCutSB.Volume(0.001) : Next If vCutB > 0 And (vCutB - vCutA) 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 1 oDoc.Update If oDef.SurfaceBodies.Count = 0 Then LogLine " [EMPTY] WASH-0001 produced no solid body" If oDef.SurfaceBodies.Count > 1 Then LogLine " [MULTIBODY] WASH-0001: " & oDef.SurfaceBodies.Count & " disconnected bodies" Dim hf, sickN, firstHS : sickN = 0 : firstHS = 0 For Each hf In oDef.Features If hf.HealthStatus 11778 And hf.HealthStatus 11783 Then sickN = sickN + 1 : If firstHS = 0 Then firstHS = hf.HealthStatus Next If sickN > 0 Then LogLine " [SICK] WASH-0001: " & sickN & " feature(s) not healthy (HS=" & firstHS & ")" Dim rb, dxx, dyy, dzz, mxx Set rb = oDef.RangeBox If Not (rb Is Nothing) Then dxx = (rb.MaxPoint.X - rb.MinPoint.X) * 10 : dyy = (rb.MaxPoint.Y - rb.MinPoint.Y) * 10 : dzz = (rb.MaxPoint.Z - rb.MinPoint.Z) * 10 mxx = dxx : If dyy > mxx Then mxx = dyy If dzz > mxx Then mxx = dzz If mxx > 50000 Then LogLine " [OVERSIZE] WASH-0001: " & Int(mxx) & " mm bounding box" End If TagBigFaces oDef If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(1), 0 SetMaterial oDoc, "Stainless steel 304" Call oDoc.SaveAs(RootPath & "\WASH-0001.ipt", False) oDoc.Close(True) End Sub Sub BuildPart_9() ' BRNG-0002 On Error Resume Next Dim oDoc, oDef, oSk, oWP, oProf, oExtDef, oFeat, oAxis, p1, p2, pts, i, oEdges, oE, oEC, nApplied, oLnF, oLn Dim vCutB, vCutA, oCutSB Dim oColl, oPatDef, oPat, oSk2, oProf2, oWP2, oSections, oLoftDef, oPath, oSk3D, oSwDef Set oDoc = oApp.Documents.Add(12290, oApp.FileManager.GetTemplateFile(12290), True) Set oDef = oDoc.ComponentDefinition LogLine " [part] BRNG-0002 (3 feature(s))" Err.Clear LogLine " [map] FEAT_1_Bearing: revolve custom_path" Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(2)) ' FEAT_1_Bearing Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(2)) ' revolve: profile coplanar with the Z (extrude) axis ReDim pts(11) Set pts(0) = oTG.CreatePoint2d(1, 0) Set pts(1) = oTG.CreatePoint2d(1.06, 0) Set pts(2) = oTG.CreatePoint2d(1.06, 0.71) Set pts(3) = oTG.CreatePoint2d(1.24, 0.71) Set pts(4) = oTG.CreatePoint2d(1.24, 0) Set pts(5) = oTG.CreatePoint2d(1.3, 0) Set pts(6) = oTG.CreatePoint2d(1.3, 1.6) Set pts(7) = oTG.CreatePoint2d(1.24, 1.6) Set pts(8) = oTG.CreatePoint2d(1.24, 0.89) Set pts(9) = oTG.CreatePoint2d(1.06, 0.89) Set pts(10) = oTG.CreatePoint2d(1.06, 1.6) Set pts(11) = oTG.CreatePoint2d(1, 1.6) Set oLnF = oSk.SketchLines.AddByTwoPoints(pts(0), pts(1)) ' chained loop → a genuinely closed region Set oLn = oLnF For i = 2 To 11 Set oLn = oSk.SketchLines.AddByTwoPoints(oLn.EndSketchPoint, pts(i)) Next Call oSk.SketchLines.AddByTwoPoints(oLn.EndSketchPoint, oLnF.StartSketchPoint) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_1_Bearing: revolve profile did not close (no region)" Set oAxis = oDef.WorkAxes.Item(3) Set oFeat = oDef.Features.RevolveFeatures.AddFull(oProf, oAxis, 20481) If Err.Number 0 Then LogLine " [FAIL] BRNG-0002 / FEAT_1_Bearing (Revolve): " & Err.Number & " " & Err.Description If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 0 Err.Clear LogLine " [map] FEAT_2_Linkageborealignpassage_Pattern: hole Ø17 through [cut] x1" vCutB = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutB = vCutB + oCutSB.Volume(0.001) : Next Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(3)) ' FEAT_2_Linkageborealignpassage_Pattern Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 0.85) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_2_Linkageborealignpassage_Pattern: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20482) SetExtent oExtDef, 2, "sym" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] BRNG-0002 / FEAT_2_Linkageborealignpassage_Pattern (Hole): " & Err.Number & " " & Err.Description vCutA = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutA = vCutA + oCutSB.Volume(0.001) : Next If vCutB > 0 And (vCutB - vCutA) 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 1 Err.Clear LogLine " [map] FEAT_3_Linkageborealignspigot_Pattern: hole Ø20 through [cut] x1" vCutB = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutB = vCutB + oCutSB.Volume(0.001) : Next Err.Clear Set oSk = oDef.Sketches.Add(oDef.WorkPlanes.Item(3)) ' FEAT_3_Linkageborealignspigot_Pattern Call oSk.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(0, 0), 1) Set oProf = oSk.Profiles.AddForSolid If oProf Is Nothing Then LogLine " [dbg] FEAT_3_Linkageborealignspigot_Pattern: empty profile" Set oExtDef = oDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProf, 20482) SetExtent oExtDef, 2, "sym" Set oFeat = oDef.Features.ExtrudeFeatures.Add(oExtDef) If Err.Number 0 Then LogLine " [FAIL] BRNG-0002 / FEAT_3_Linkageborealignspigot_Pattern (Hole): " & Err.Number & " " & Err.Description vCutA = 0 : For Each oCutSB In oDef.SurfaceBodies : vCutA = vCutA + oCutSB.Volume(0.001) : Next If vCutB > 0 And (vCutB - vCutA) 0 Then TagFeatureFaces oDef.Features.Item(oDef.Features.Count), 2 oDoc.Update If oDef.SurfaceBodies.Count = 0 Then LogLine " [EMPTY] BRNG-0002 produced no solid body" If oDef.SurfaceBodies.Count > 1 Then LogLine " [MULTIBODY] BRNG-0002: " & oDef.SurfaceBodies.Count & " disconnected bodies" Dim hf, sickN, firstHS : sickN = 0 : firstHS = 0 For Each hf In oDef.Features If hf.HealthStatus 11778 And hf.HealthStatus 11783 Then sickN = sickN + 1 : If firstHS = 0 Then firstHS = hf.HealthStatus Next If sickN > 0 Then LogLine " [SICK] BRNG-0002: " & sickN & " feature(s) not healthy (HS=" & firstHS & ")" Dim rb, dxx, dyy, dzz, mxx Set rb = oDef.RangeBox If Not (rb Is Nothing) Then dxx = (rb.MaxPoint.X - rb.MinPoint.X) * 10 : dyy = (rb.MaxPoint.Y - rb.MinPoint.Y) * 10 : dzz = (rb.MaxPoint.Z - rb.MinPoint.Z) * 10 mxx = dxx : If dyy > mxx Then mxx = dyy If dzz > mxx Then mxx = dzz If mxx > 50000 Then LogLine " [OVERSIZE] BRNG-0002: " & Int(mxx) & " mm bounding box" End If TagBigFaces oDef If oDef.Features.Count > 0 Then TagFeatureFaces oDef.Features.Item(1), 0 SetMaterial oDoc, "Generic" Call oDoc.SaveAs(RootPath & "\BRNG-0002.ipt", False) oDoc.Close(True) End Sub Sub BuildAsm_1() ' ASSY-0001 On Error Resume Next Dim oDoc, oDef, oCons, oBase, oChild, oOccById Set oDoc = oApp.Documents.Add(12291, oApp.FileManager.GetTemplateFile(12291), True) Set oDef = oDoc.ComponentDefinition Set oCons = oDef.Constraints Set oOccById = CreateObject("Scripting.Dictionary") Set gUsed = CreateObject("Scripting.Dictionary") Set gInserts = CreateObject("Scripting.Dictionary") Set gInsertTags = CreateObject("Scripting.Dictionary") Set oBase = AddOcc(oDef, RootPath & "\GEAR-0004.ipt", 0, 0, 0, 0) If Not oBase Is Nothing Then oBase.Grounded = True : oOccById.Add "GEAR-0004:1", oBase Set oChild = AddOcc(oDef, RootPath & "\GEAR-0001.ipt", 0, 0, 0, 0) If Not oChild Is Nothing Then oOccById.Add "GEAR-0001:1", oChild Set oChild = AddOcc(oDef, RootPath & "\GEAR-0002.ipt", 52.5, 195, 0, 0) If Not oChild Is Nothing Then oOccById.Add "GEAR-0002:1", oChild If Not oChild Is Nothing Then oChild.Grounded = True Set oChild = AddOcc(oDef, RootPath & "\GEAR-0003.ipt", 0, 195, 0, 0) If Not oChild Is Nothing Then oOccById.Add "GEAR-0003:1", oChild Set oChild = AddOcc(oDef, RootPath & "\BRNG-0001.ipt", 0, 255, 0, 0) If Not oChild Is Nothing Then oOccById.Add "BRNG-0001:1", oChild Set oChild = AddOcc(oDef, RootPath & "\MOUN-0001.ipt", 0, 585, 36.5, 0) If Not oChild Is Nothing Then oOccById.Add "MOUN-0001:1", oChild Set oChild = AddOcc(oDef, RootPath & "\SCRW-0001.ipt", -76, -76, 36.5, 0) If Not oChild Is Nothing Then oOccById.Add "SCRW-0001:1", oChild Set oChild = AddOcc(oDef, RootPath & "\SCRW-0001.ipt", 76, -76, 36.5, 0) If Not oChild Is Nothing Then oOccById.Add "SCRW-0001:2", oChild Set oChild = AddOcc(oDef, RootPath & "\SCRW-0001.ipt", 228, -76, 36.5, 0) If Not oChild Is Nothing Then oOccById.Add "SCRW-0001:3", oChild Set oChild = AddOcc(oDef, RootPath & "\SCRW-0001.ipt", -228, 76, 36.5, 0) If Not oChild Is Nothing Then oOccById.Add "SCRW-0001:4", oChild Set oChild = AddOcc(oDef, RootPath & "\WASH-0001.ipt", -76, 76, 36.5, 0) If Not oChild Is Nothing Then oOccById.Add "WASH-0001:1", oChild Set oChild = AddOcc(oDef, RootPath & "\WASH-0001.ipt", 76, 76, 36.5, 0) If Not oChild Is Nothing Then oOccById.Add "WASH-0001:2", oChild Set oChild = AddOcc(oDef, RootPath & "\WASH-0001.ipt", 228, 76, 36.5, 0) If Not oChild Is Nothing Then oOccById.Add "WASH-0001:3", oChild Set oChild = AddOcc(oDef, RootPath & "\WASH-0001.ipt", -228, 228, 36.5, 0) If Not oChild Is Nothing Then oOccById.Add "WASH-0001:4", oChild Set oChild = AddOcc(oDef, RootPath & "\BRNG-0002.ipt", 0, 485, 0, 0) If Not oChild Is Nothing Then oOccById.Add "BRNG-0002:1", oChild LogLine " [ai] executing 9 AI constraint(s)" ConcentricById oCons, oOccById, "BRNG-0002:1", "GEAR-0003:1", 1, 1, "axis GEAR-0003:1~BRNG-0002:1" MateByKeyRole oCons, oOccById, "MOUN-0001:1", "face_hi", "GEAR-0004:1", "face_lo", 0, True, "MOUN-0001:1~GEAR-0004:1" ConcentricById oCons, oOccById, "GEAR-0004:1", "MOUN-0001:1", 0.275, 0.275, "axis MOUN-0001:1~GEAR-0004:1" InsertById oCons, oOccById, "GEAR-0004:1", "BRNG-0002:1", 1, 1.3, False, "cyl-insert BRNG-0002:1~GEAR-0004:1", -99999 MateByKeyRole oCons, oOccById, "BRNG-0001:1", "face_hi", "GEAR-0004:1", "face_hi", 0, True, "BRNG-0001:1~GEAR-0004:1" InsertById oCons, oOccById, "BRNG-0001:1", "GEAR-0003:1", 1, 1, True, "GEAR-0003:1 insert", -99999 InsertById oCons, oOccById, "GEAR-0003:1", "GEAR-0001:1", 1.125, 1.125, False, "GEAR-0001:1 insert", -99999 ConcentricById oCons, oOccById, "GEAR-0004:1", "BRNG-0001:1", 1, 1, "axis BRNG-0001:1~GEAR-0004:1" LogLine " [ai] bolt_stack SCRW-0001 x4 through 2 member(s)" AnchorClockById oCons, oOccById, "GEAR-0004:1", 4, "MOUN-0001:1", 3, "clock MOUN-0001:1" BoltThroughStack oCons, oOccById, "GEAR-0004:1", "face_hi", "MOUN-0001:1", "face_lo", "SCRW-0001:1", "WASH-0001:1", "WASH-0001:5", "WASH-0001:1", 0.275, 0.25, 0.275, 0.275, "SCRW-0001:1" BoltThroughStack oCons, oOccById, "GEAR-0004:1", "face_hi", "MOUN-0001:1", "face_lo", "SCRW-0001:2", "WASH-0001:2", "WASH-0001:6", "WASH-0001:2", 0.275, 0.25, 0.275, 0.275, "SCRW-0001:2" BoltThroughStack oCons, oOccById, "GEAR-0004:1", "face_hi", "MOUN-0001:1", "face_lo", "SCRW-0001:3", "WASH-0001:3", "WASH-0001:7", "WASH-0001:3", 0.275, 0.25, 0.275, 0.275, "SCRW-0001:3" BoltThroughStack oCons, oOccById, "GEAR-0004:1", "face_hi", "MOUN-0001:1", "face_lo", "SCRW-0001:4", "WASH-0001:4", "WASH-0001:8", "WASH-0001:4", 0.275, 0.25, 0.275, 0.275, "SCRW-0001:4" Dim cUq, cUn, cP1, cP2, cPair : cUn = 0 For Each cUq In oCons If cUq.HealthStatus 11778 And cUq.HealthStatus 11783 Then cP1 = "" : cP2 = "" : cPair = "" Err.Clear cP1 = cUq.OccurrenceOne.Name : cP2 = cUq.OccurrenceTwo.Name Err.Clear If cP1 "" And cP2 "" Then cPair = " {" & cP1 & "~" & cP2 & "}" LogLine " [UNSOLVED] ASSY-0001~" & cUq.Name & cPair & ": added but not solved (health " & cUq.HealthStatus & ") — Inventor's warning mark" cUn = cUn + 1 End If Next If cUn > 0 Then LogLine " [UNSOLVED-TOTAL] ASSY-0001: " & cUn & " constraint(s) carry Inventor's warning mark" Err.Clear If gInserts.Count > 0 And oDef.Occurrences.Count >= 2 And oDef.Occurrences.Count 1 And gInserts.Exists(rsKey) Then Set rsA = oRs1.OccurrenceOne.RangeBox : Set rsB = oRs1.OccurrenceTwo.RangeBox rsX = (MinD(rsA.MaxPoint.X, rsB.MaxPoint.X) - MaxD(rsA.MinPoint.X, rsB.MinPoint.X)) * 10 rsY = (MinD(rsA.MaxPoint.Y, rsB.MaxPoint.Y) - MaxD(rsA.MinPoint.Y, rsB.MinPoint.Y)) * 10 rsZ = (MinD(rsA.MaxPoint.Z, rsB.MaxPoint.Z) - MaxD(rsA.MinPoint.Z, rsB.MinPoint.Z)) * 10 If rsZ > 0.01 And rsZ <= 2 And rsZ * 3 <= MinD(rsX, rsY) Then Set oRsCon = gInserts.Item(rsKey) rsFixed = False : rsSaved = 0 Err.Clear : rsSaved = oRsCon.Distance.Value If Err.Number 0 Then Err.Clear : rsSaved = oRsCon.Offset.Value rsTryArr = Array(rsSaved + rsZ/10, rsSaved - rsZ/10) For rsJ = 0 To 1 Err.Clear oRsCon.Distance.Value = rsTryArr(rsJ) If Err.Number 0 Then Err.Clear : oRsCon.Offset.Value = rsTryArr(rsJ) oDoc.Update Set oRsPair = oApp.TransientObjects.CreateObjectCollection() oRsPair.Add oRs1.OccurrenceOne : oRsPair.Add oRs1.OccurrenceTwo Err.Clear Set oRsRes2 = oDef.AnalyzeInterference(oRsPair) rsVol2 = 0 If Err.Number = 0 And Not oRsRes2 Is Nothing Then For rsK = 1 To oRsRes2.Count : rsVol2 = rsVol2 + oRsRes2.Item(rsK).Volume * 1000 : Next End If If rsVol2 <= 1 Then LogLine " [RESEAT] " & gInsertTags.Item(rsKey) & ": " & Round(rsZ, 2) & " mm axial lap — insert offset " & Round((rsTryArr(rsJ) - rsSaved) * 10, 2) & " mm cleared it (re-seated, not re-modelled)" rsFixed = True : Exit For End If Next If Not rsFixed Then Err.Clear oRsCon.Distance.Value = rsSaved If Err.Number 0 Then Err.Clear : oRsCon.Offset.Value = rsSaved oDoc.Update LogLine " [RESEAT] " & gInsertTags.Item(rsKey) & ": " & Round(rsZ, 2) & " mm axial lap — offset tried both ways, interference REMAINS (offset restored; the scan below reports it)" End If End If End If Next End If Err.Clear End If Err.Clear If oDef.Occurrences.Count >= 2 And oDef.Occurrences.Count 1 Then Set rIA = oInt1.OccurrenceOne.RangeBox : Set rIB = oInt1.OccurrenceTwo.RangeBox ovX = (MinD(rIA.MaxPoint.X, rIB.MaxPoint.X) - MaxD(rIA.MinPoint.X, rIB.MinPoint.X)) * 10 ovY = (MinD(rIA.MaxPoint.Y, rIB.MaxPoint.Y) - MaxD(rIA.MinPoint.Y, rIB.MinPoint.Y)) * 10 ovZ = (MinD(rIA.MaxPoint.Z, rIB.MaxPoint.Z) - MaxD(rIA.MinPoint.Z, rIB.MinPoint.Z)) * 10 Dim bvA, bvB bvA = Int((rIA.MaxPoint.X - rIA.MinPoint.X) * (rIA.MaxPoint.Y - rIA.MinPoint.Y) * (rIA.MaxPoint.Z - rIA.MinPoint.Z) * 1000) bvB = Int((rIB.MaxPoint.X - rIB.MinPoint.X) * (rIB.MaxPoint.Y - rIB.MinPoint.Y) * (rIB.MaxPoint.Z - rIB.MinPoint.Z) * 1000) LogLine " [INTERSECT] ASSY-0001~" & oInt1.OccurrenceOne.Name & "~" & oInt1.OccurrenceTwo.Name & ": vol " & Int(vMm3) & " mm3 centroid (" & Round(oInt1.Centroid.X * 10, 1) & "," & Round(oInt1.Centroid.Y * 10, 1) & "," & Round(oInt1.Centroid.Z * 10, 1) & ") extent (" & Round(ovX, 1) & "x" & Round(ovY, 1) & "x" & Round(ovZ, 1) & ") boxes (" & bvA & "|" & bvB & ")" End If Next End If Err.Clear ElseIf oDef.Occurrences.Count > 80 Then LogLine " [INTERSECT-SKIP] ASSY-0001: " & oDef.Occurrences.Count & " occurrence(s) — interference scan skipped for scale" End If Dim oPosOcc For Each oPosOcc In oDef.Occurrences LogLine " [pos] ASSY-0001~" & oPosOcc.Name & ": " & Round(oPosOcc.Transformation.Translation.X * 10, 2) & " " & Round(oPosOcc.Transformation.Translation.Y * 10, 2) & " " & Round(oPosOcc.Transformation.Translation.Z * 10, 2) Next Call oDoc.SaveAs(RootPath & "\ASSY-0001.iam", False) oDoc.Close(True) End Sub Sub Main() EnsureFolder RootPath StartLog Set oApp = GetInventor() If oApp Is Nothing Then LogLine "[fatal] Inventor not available - Autodesk Inventor must be installed to build geometry." MsgBox "Autodesk Inventor is not available." & vbCrLf & vbCrLf & "Proxima C needs Inventor installed to build geometry. Your BOM is unaffected.", 48, "Proximas AI" Exit Sub End If oApp.Visible = True Set oTG = oApp.TransientGeometry On Error Resume Next ProbeCylType If CreateObject("Scripting.FileSystemObject").FileExists(RootPath & "\GEAR-0001.ipt") Then LogLine " [reuse] GEAR-0001 - unchanged since its last good build" Else BuildPart_1 End If If CreateObject("Scripting.FileSystemObject").FileExists(RootPath & "\GEAR-0002.ipt") Then LogLine " [reuse] GEAR-0002 - unchanged since its last good build" Else BuildPart_2 End If If CreateObject("Scripting.FileSystemObject").FileExists(RootPath & "\GEAR-0003.ipt") Then LogLine " [reuse] GEAR-0003 - unchanged since its last good build" Else BuildPart_3 End If BuildPart_4 If CreateObject("Scripting.FileSystemObject").FileExists(RootPath & "\GEAR-0004.ipt") Then LogLine " [reuse] GEAR-0004 - unchanged since its last good build" Else BuildPart_5 End If If CreateObject("Scripting.FileSystemObject").FileExists(RootPath & "\MOUN-0001.ipt") Then LogLine " [reuse] MOUN-0001 - unchanged since its last good build" Else BuildPart_6 End If If CreateObject("Scripting.FileSystemObject").FileExists(RootPath & "\SCRW-0001.ipt") Then LogLine " [reuse] SCRW-0001 - unchanged since its last good build" Else BuildPart_7 End If If CreateObject("Scripting.FileSystemObject").FileExists(RootPath & "\WASH-0001.ipt") Then LogLine " [reuse] WASH-0001 - unchanged since its last good build" Else BuildPart_8 End If BuildPart_9 BuildAsm_1 On Error Goto 0 LogLine "[done] " & RootPath & "\ASSY-0001.iam" End Sub Call Main()