Code:
Const strMacroName As String = "TrimGrid"
Const strMacroVersion As String = "1.0"Const dblr1 As Double = 2 'kleiner radius in mm
Const dbls1 As Double = dblr1 + 2 'randabstand kleiner kreis zu grosser kreis
Const dbls2 As Double = dblr1 + 2.5 'randabstand kleiner kreis zu mittlerem kreis
Sub CATMain()
Dim oADP As Part
Dim oHSF As HybridShapeFactory
Dim oOuterCircle As HybridShape 'main circle
Dim oInnerCircle As HybridShape 'pipe circle
Dim oPtCenter As HybridShape 'center of main circle
Dim oPtRef As Reference 'ref of oPtCenter
Dim oRef As Reference 'ref of grid point
Dim n As Integer
Dim oSel As Selection
Dim oGrid As RectPattern
Dim strGridPt As String 'grid point string, eg. 13-21(rol/col)
Dim strTemp As String
Dim SPA_WB As Workbench
Dim oCPoint As Measurable 'representing center of the circle
Dim iStart As Integer
Dim iEnd As Integer
Dim dblOuterRad As Double 'radius outer circle
Dim dblOuterRadZul As Double 'reduced outer circle
Dim dblInnerRad As Double 'radius inner circle
Dim dblInnerRadZul As Double 'reduced inner circle
Dim oHBCircles As HybridBody 'set for circles
Dim oRefPlane As Reference 'support plane for circles
Dim oHSCircle As HybridShapeCircle 'new circle object
CATIA.RefreshDisplay = False
Set oADP = CATIA.ActiveDocument.Part
Set oSel = CATIA.ActiveDocument.Selection
oSel.Clear
Set oGrid = oADP.hybridBodies.Item("PointGrid").HybridShapes.Item("Grid")
oSel.Add oGrid 'select grid
oSel.Search "Topology.CGMVertex,sel" 'select points in grid
Set SPA_WB = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
'delete points outside large circle
Set oPtCenter = oADP.hybridBodies.Item("WireFrame").HybridShapes.Item("pt_CPCircle")
Set oOuterCircle = oADP.hybridBodies.Item("WireFrame").HybridShapes.Item("OuterCircle")
Set oPtRef = oOuterCircle.Center 'set centerpoint of circle reference
Set oCPoint = SPA_WB.GetMeasurable(oPtRef)
dblOuterRad = oOuterCircle.Radius.Value 'get radius of main circle
dblOuterRadZul = dblOuterRad - dbls1 'reduce radius by margin
For n = oSel.Count2 To 1 Step -1
'build reference
strTemp = oSel.Item2(n).Value.Name
iStart = InStr(strTemp, "RectPattern.1;") + Len("RectPattern.1;")
iEnd = InStr(iStart, strTemp, ":")
strGridPt = Mid(strTemp, iStart, iEnd - iStart)
Set oRef = oADP.CreateReferenceFromBRepName("BorderFVertex:(BEdge:(Brp:(" _
& oGrid.Name & ";" & strGridPt _
& ":(Brp:(GSMPoint.1)));None:(Limits1:();Limits2:();+1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", _
oGrid)
'get distance to center point
If oCPoint.GetMinimumDistance(oRef) > dblOuterRadZul Then
oSel.Remove2 (n) 'if outside remove from selection
End If
DoEvents
Next
Debug.Print "Finished outer circle", oSel.Count2 & " points remaining"
'delete points from inner circle
Set oPtCenter = oADP.hybridBodies.Item("WireFrame").HybridShapes.Item("pt_CPCircleInner")
Set oInnerCircle = oADP.hybridBodies.Item("WireFrame").HybridShapes.Item("InnerCircle")
Set oPtRef = oInnerCircle.Center 'set centerpoint of circle reference
Set oCPoint = SPA_WB.GetMeasurable(oPtRef)
dblInnerRad = oInnerCircle.Radius.Value 'get pipe radius
dblInnerRadZul = dblInnerRad + dbls2 'add margin
For n = oSel.Count2 To 1 Step -1
'build reference
strTemp = oSel.Item2(n).Value.Name
iStart = InStr(strTemp, "RectPattern.1;") + Len("RectPattern.1;")
iEnd = InStr(iStart, strTemp, ":")
strGridPt = Mid(strTemp, iStart, iEnd - iStart)
Set oRef = oADP.CreateReferenceFromBRepName("BorderFVertex:(BEdge:(Brp:(" _
& oGrid.Name & ";" & strGridPt _
& ":(Brp:(GSMPoint.1)));None:(Limits1:();Limits2:();+1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", _
oGrid)
'get distance to center point
If oCPoint.GetMinimumDistance(oRef) < dblInnerRadZul Then
oSel.Remove2 (n) 'if inside remove
End If
DoEvents
Next
Debug.Print "Finished inner circle", oSel.Count2 & " points remaining"
'create circles
Set oHBCircles = oADP.hybridBodies.Add
oHBCircles.Name = "Circles"
' Set oHBCircles = oADP.hybridBodies.Item("Circles")
Set oHSF = oADP.HybridShapeFactory
Set oRefPlane = oOuterCircle.Support 'get support reference
For n = oSel.Count2 To 1 Step -1
'build reference
strTemp = oSel.Item2(n).Value.Name
iStart = InStr(strTemp, "RectPattern.1;") + Len("RectPattern.1;")
iEnd = InStr(iStart, strTemp, ":")
strGridPt = Mid(strTemp, iStart, iEnd - iStart)
Set oRef = oADP.CreateReferenceFromBRepName("BorderFVertex:(BEdge:(Brp:(" & oGrid.Name & ";" & strGridPt & ":(Brp:(GSMPoint.1)));None:(Limits1:();Limits2:();+1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", oGrid)
'create circle
Set oHSCircle = oHSF.AddNewCircleCtrRad(oRef, oRefPlane, True, dblr1)
oHSCircle.SetLimitation 1 'closed circle
oHBCircles.AppendHybridShape oHSCircle 'add to set
oHSCircle.AxisComputation = True 'add axis
DoEvents
Next
'main circle center is always inside main circle
'check pipe region; measure ptref(pipe) against the center of the main circle
Set oPtCenter = oADP.hybridBodies.Item("WireFrame").HybridShapes.Item("pt_CPCircle")
Set oRef = oADP.CreateReferenceFromObject(oPtCenter)
If oCPoint.GetMinimumDistance(oRef) > dblInnerRadZul Then
'create circle
Set oHSCircle = oHSF.AddNewCircleCtrRad(oRef, oRefPlane, True, dblr1)
oHSCircle.SetLimitation 1 'closed circle
oHBCircles.AppendHybridShape oHSCircle 'add to set
oHSCircle.AxisComputation = True 'add axis
End If
Debug.Print "Finished creating circles"
oSel.Clear
oADP.Update
CATIA.RefreshDisplay = True
oADP.Update
DoEvents
End Sub