|
经典案例图书 Dim swApp As SldWorks.SldWorks
Dim model As ModelDoc2
Dim swdrw As DrawingDoc
Dim swselmgr As SelectionMgr
Dim swview As View
Public swEdge As Edge
Dim swentity As Entity
Dim swcurve As Curve
Dim swCurveParaData As SldWorks.CurveParamData
Dim swLoop As SldWorks.Loop2
Dim swSelData As SldWorks.SelectData
Dim swFace As SldWorks.Face2
Public loop_arr()
Public collect_count
Public goal_line_count
Dim temp_edge_box()
Sub SelectLoop(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swLoop As SldWorks.Loop2, swSelData As SldWorks.SelectData)
Dim vEdgeArr As Variant
Dim vEdge As Variant
Dim swEdge As SldWorks.Edge
Dim swEnt As SldWorks.Entity
Dim bRet As Boolean
vEdgeArr = swLoop.GetEdges
Debug.Assert Not IsEmpty(vEdgeArr)
For Each vEdge In vEdgeArr
Set swEdge = vEdge
Set swEnt = swEdge
bRet = swEnt.Select4(True, swSelData)
Next
End Sub
Function pop_array_item(arr, index)
Dim temp_box()
If Not UBound(arr) = 0 Then
ReDim Preserve temp_box(UBound(arr) - 1)
j = 0
For i = 0 To UBound(arr)
If i <> index Then
Set temp_box(j) = arr(i)
j = j + 1
End If
Next
pop_array_item = temp_box
End If
End Function
Function get_valid_index(k, ope, num)
a = UBound(loop_arr) * 3 - 1
ReDim new_arr(a)
For i = 0 To UBound(loop_arr) - 1
new_arr(i) = i
new_arr(i + UBound(loop_arr)) = i
new_arr(i + UBound(loop_arr) * 2) = i
Next
If ope = "+" Then
get_valid_index = new_arr(UBound(loop_arr) + k + num)
ElseIf ope = "-" Then
get_valid_index = new_arr(UBound(loop_arr) + k - num)
End If
End Function
Sub search_next_edge(cur_swCurveParaData, vEdges, searchtype)
If searchtype = 1 Then
a = cur_swCurveParaData.EndPoint
Else
a = cur_swCurveParaData.StartPoint
End If
ReDim Preserve temp_edge_box(0)
For i = 0 To UBound(vEdges)
Set swEdge = vEdges(i)
Set swCurveParaData = swEdge.GetCurveParams3
b = swCurveParaData.StartPoint
c = swCurveParaData.EndPoint
Dim d(2)
'match at start point
If a(0) = b(0) And a(1) = b(1) And a(2) = b(2) Then
Debug.Print "match at start point"
Set d(0) = swEdge
d(1) = i
d(2) = 1
temp_edge_box(UBound(temp_edge_box)) = d
ReDim Preserve temp_edge_box(UBound(temp_edge_box) + 1)
'match at end point
ElseIf a(0) = c(0) And a(1) = c(1) And a(2) = c(2) Then
Debug.Print "match at end point"
Set d(0) = swEdge
d(1) = i
d(2) = 2
temp_edge_box(UBound(temp_edge_box)) = d
ReDim Preserve temp_edge_box(UBound(temp_edge_box) + 1)
End If
Next
ReDim Preserve temp_edge_box(UBound(temp_edge_box) - 1)
''''when the case there are intersection
'this algorithm choose the longer line
If UBound(temp_edge_box) = 1 Then
index = 0
cur_len = 0
Set cur_curve = temp_edge_box(0)(0).GetCurve
vCurveParam = temp_edge_box(0)(0).GetCurveParams2
Set swCurveParaData1 = temp_edge_box(0)(0).GetCurveParams3
len1 = cur_curve.GetLength2(vCurveParam(6), vCurveParam(7))
Debug.Print len1
Set cur_curve = temp_edge_box(1)(0).GetCurve
vCurveParam = temp_edge_box(1)(0).GetCurveParams2
Set swCurveParaData2 = temp_edge_box(1)(0).GetCurveParams3
len2 = cur_curve.GetLength2(vCurveParam(6), vCurveParam(7))
Debug.Print len2
If len1 < len2 Then
searchtype = temp_edge_box(1)(2)
Set loop_arr(UBound(loop_arr)) = temp_edge_box(1)(0)
ReDim Preserve loop_arr(UBound(loop_arr) + 1)
vEdges = pop_array_item(vEdges, temp_edge_box(1)(1))
vEdges = pop_array_item(vEdges, temp_edge_box(0)(1))
Set swCurveParaData = swCurveParaData2
GoTo next_line
Else
searchtype = temp_edge_box(0)(2)
Set loop_arr(UBound(loop_arr)) = temp_edge_box(0)(0)
ReDim Preserve loop_arr(UBound(loop_arr) + 1)
vEdges = pop_array_item(vEdges, temp_edge_box(1)(1))
vEdges = pop_array_item(vEdges, temp_edge_box(0)(1))
Set swCurveParaData = swCurveParaData1
GoTo next_line
End If
Else
searchtype = temp_edge_box(0)(2)
Set swCurveParaData = temp_edge_box(0)(0).GetCurveParams3
Set loop_arr(UBound(loop_arr)) = temp_edge_box(0)(0)
ReDim Preserve loop_arr(UBound(loop_arr) + 1)
vEdges = pop_array_item(vEdges, temp_edge_box(0)(1))
next_line:
Set swentity = loop_arr(UBound(loop_arr) - 1)
swentity.Select False
If Not goal_line_count = UBound(loop_arr) Then
search_next_edge swCurveParaData, vEdges, searchtype
End If
Debug.Print "!!"
End If
End Sub
Function select_loop()
For i = 0 To UBound(loop_arr) - 1
Set swentity = loop_arr(i)
swentity.Select True
Next
End Function
Sub main()
Set swApp = Application.SldWorks
Set model = swApp.ActiveDoc
Set swdrw = model
Set swselmgr = model.SelectionManager
Set swview = swdrw.ActiveDrawingView
If swview Is Nothing Then
swApp.SendMsgToUser "Please select a view"
End
End If
vComps = swview.GetVisibleComponents
vEdges = swview.GetVisibleEntities2(vComps(0), swViewEntityType_Edge)
vVertex = swview.GetVisibleEntities2(vComps(0), swViewEntityType_Vertex)
'calculate bend parameters
bend_Count = (UBound(vEdges) - UBound(vVertex)) / 2
bend_line_count = bend_Count * 2
goal_line_count = UBound(vEdges) - bend_line_count + 1
'sort loop line
ReDim Preserve loop_arr(0)
For i = 0 To UBound(vEdges)
Set swEdge = vEdges(i)
Set swCurveParaData = swEdge.GetCurveParams3
Debug.Print swCurveParaData.CurveType
'3001 : LINE_TYPE
'3002 : CIRCLE_TYPE
Set swcurve = swEdge.GetCurve
Set swentity = swEdge
swentity.Select False
If swCurveParaData.CurveType = "3002" Then
If UBound(loop_arr) = 0 Then
Set loop_arr(UBound(loop_arr)) = swEdge
ReDim Preserve loop_arr(UBound(loop_arr) + 1)
vEdges = pop_array_item(vEdges, i)
search_next_edge swCurveParaData, vEdges, 1
Exit For
End If
End If
Next
'pick key index
k = 0
len1 = 0
For i = 0 To UBound(loop_arr) - 1
Set swEdge = loop_arr(i)
vCurveParam = swEdge.GetCurveParams2
Set swCurveParaData = swEdge.GetCurveParams3
Debug.Print swCurveParaData.CurveType
Set swcurve = swEdge.GetCurve
Set swentity = swEdge
If swCurveParaData.CurveType = "3002" Then
If len1 = 0 Then
k = i
len1 = swcurve.GetLength2(vCurveParam(6), vCurveParam(7))
Else
len2 = swcurve.GetLength2(vCurveParam(6), vCurveParam(7))
If len2 > len1 Then
k = i
End If
End If
End If
Next
'create point
model.ClearSelection2 True
Dim skPoint As SketchPoint
Set skPoint = model.SketchManager.CreatePoint(0#, 0#, 0#)
Set swentity = loop_arr(get_valid_index(k, "+", 1))
swentity.Select True
Set swentity = loop_arr(get_valid_index(k, "-", 1))
swentity.Select True
model.SketchAddConstraints "sgATINTERSECT"
'dim1
model.ClearSelection2 True
skPoint.Select True
Set swentity = loop_arr(get_valid_index(k, "-", 2))
swentity.Select True
Set myDisplayDim1 = model.AddDimension2(2.89904912802659E-02, 0.116787613208301, 0)
Status = model.Extension.AlignDimensions(swAlignDimensionType_e.swAlignDimensionType_AutoArrange, 0.001)
'dim2
model.ClearSelection2 True
skPoint.Select True
Set swentity = loop_arr(get_valid_index(k, "+", 2))
swentity.Select True
Set myDisplayDim2 = model.AddDimension2(2.89904912802659E-02, 0.116787613208301, 0)
Status = model.Extension.AlignDimensions(swAlignDimensionType_e.swAlignDimensionType_AutoArrange, 0.001)
' Set swentity = loop_arr(k)
' swentity.Select False
'Part.SketchAddConstraints ("sgATINTERSECT")
End Sub
|
|