Get Center of Hole Example (VBA)
This example shows how to get the center of a hole not normal to a face.
'----------------------------------------------
'
' Preconditions:
' (1)
Part is open.
' (2)
Edge of a hole is selected.
' (3)
Hole enters part on a flat face.
'
' Postconditions: 3D sketch is created of a single point
at the
' center
of the hole.
'
'-----------------------------------------------
Option Explicit
Sub main()
Dim
swApp As
SldWorks.SldWorks
Dim
swMathUtil As
SldWorks.MathUtility
Dim
swModel As
SldWorks.ModelDoc2
Dim
swSelMgr As
SldWorks.SelectionMgr
Dim
swEdge As
SldWorks.Edge
Dim
vFace As
Variant
Dim
swFace(1) As
SldWorks.face2
Dim
swSurf(1) As
SldWorks.surface
Dim
swCylSurf As
SldWorks.surface
Dim
swFlatSurf As
SldWorks.surface
Dim
vCylinder As
Variant
Dim
vPlane As
Variant
Dim
nVector(2) As
Double
Dim
vVector As
Variant
Dim
nPt(2) As
Double
Dim
vPt As
Variant
Dim
swN As
SldWorks.MathVector
Dim
swP1 As
SldWorks.MathPoint
Dim
swP2 As
SldWorks.MathPoint
Dim
swP3 As
SldWorks.MathPoint
Dim
swP2_P1 As
SldWorks.MathVector
Dim
swP3_P1 As
SldWorks.MathVector
Dim
swIntPt As
SldWorks.MathPoint
Dim
swIntSkPt As
SldWorks.SketchPoint
Dim
u As
Double
Dim
i As
Long
Dim
bRet As
Boolean
Set
swApp = Application.SldWorks
Set
swMathUtil = swApp.GetMathUtility
Set
swModel = swApp.ActiveDoc
Set
swSelMgr = swModel.SelectionManager
Set
swEdge = swSelMgr.GetSelectedObject5(1)
vFace
= swEdge.GetTwoAdjacentFaces2
Set
swFace(0) = vFace(0)
Set
swFace(1) = vFace(1)
Set
swSurf(0) = swFace(0).GetSurface
Set
swSurf(1) = swFace(1).GetSurface
If
swSurf(0).IsCylinder Then
Set
swCylSurf = swSurf(0)
Set
swFlatSurf = swSurf(1)
Else
Debug.Assert
swSurf(0).IsPlane
Debug.Assert
swSurf(1).IsCylinder
Set
swCylSurf = swSurf(1)
Set
swFlatSurf = swSurf(0)
End
If
vCylinder
= swCylSurf.CylinderParams
vPlane
= swFlatSurf.PlaneParams
'
Plane
'
N
dot (P - P3) = 0
'
'
Line
'
P
= P1 + u (P2 - P1)
'
'
Intersection
'
u
= [N dot (P3 - P1)] / [N dot (P2 - P1)]
'
N = flat normal
nVector(0)
= vPlane(0): nVector(1)
= vPlane(1): nVector(2)
= vPlane(2)
vVector
= nVector
Set
swN = swMathUtil.CreateVector((vVector))
'
P1 = cylinder origin
nPt(0)
= vCylinder(0): nPt(1)
= vCylinder(1): nPt(2)
= vCylinder(2)
vPt
= nPt
Set
swP1 = swMathUtil.CreatePoint((vPt))
'
P2 = P1 + cylinder axis
nPt(0)
= vCylinder(0) + vCylinder(3): nPt(1)
= vCylinder(1) + vCylinder(4): nPt(2)
= vCylinder(2) + vCylinder(5)
vPt
= nPt
Set
swP2 = swMathUtil.CreatePoint((vPt))
'
P3 = flat root
nPt(0)
= vPlane(3): nPt(1)
= vPlane(4): nPt(2)
= vPlane(5)
vPt
= nPt
Set
swP3 = swMathUtil.CreatePoint((vPt))
'
u
= [N dot (P3 - P1)] / [N dot (P2 - P1)]
Set
swP2_P1 = swP2.Subtract(swP1)
Set
swP3_P1 = swP3.Subtract(swP1)
u
= swN.Dot(swP3_P1) / swN.Dot(swP2_P1)
Set
swIntPt = swP1.AddVector(swP2_P1.Scale(u))
Debug.Print
"File = " & swModel.GetPathName
Debug.Print
" Cylinder
origin
=
(" & vCylinder(0) * 1000# & ", " & vCylinder(1)
* 1000# & ", " & vCylinder(2) * 1000# & ")
mm"
Debug.Print
" Cylinder
axis =
(" & vCylinder(3) & ", " & vCylinder(4) &
", " & vCylinder(5) & ")"
Debug.Print
" Cylinder
radius
=
" & vCylinder(6) * 1000# & " mm"
Debug.Print
" Flat
normal =
(" & vPlane(0) & ", " & vPlane(1) & ",
" & vPlane(2) & ")"
Debug.Print
" Flat
root =
(" & vPlane(3) * 1000# & ", " & vPlane(4) *
1000# & ", " & vPlane(5) * 1000# & ") mm"
Debug.Print
" Intersection
=
" & swIntPt.ArrayData(0)
* 1000# & ", " & swIntPt.ArrayData(1)
* 1000# & ", " & swIntPt.ArrayData(2)
* 1000# & ") mm"
swModel.Insert3DSketch2 False
swModel.SetAddToDB True
Set
swIntSkPt = swModel.CreatePoint2(swIntPt.ArrayData(0), swIntPt.ArrayData(1),
swIntPt.ArrayData(2))
swModel.SetAddToDB False
swModel.Insert3DSketch2 True
End Sub
'----------------------------------------------