|
|
宏是个好东西,可实现很多梦想.
例如:
Option Explicit
Public Const HH_TOPIC_ID As Long = 210001
Public m_SelFace As SldWorks.Face2
Public m_SelFaceId() As Byte
Public m_SelPoint As Variant
Public m_Angle As Double
Public m_ExType As Long
Public m_Direction As Boolean
Public m_Normalize As Boolean
Public m_RegKey As String
'Const m_EachKey As String = "TubeMacroShmTubeRecover"
Public Const PAI As Double = 3.14159265359
Dim m_swPage As PropMgr
'>20070616>
Public m_UpdateStamp As Long
Public m_IsPartMode As Boolean
'<20070616<
'>20071221>
Public Const Tolerance As Double = 0.0000001
'<20071221<
Public m_IconsPath As String
Public m_Page As SldWorks.PropertyManagerPage2
Public m_vFeats As Variant
Public m_vSketchs As Variant
Public m_tmpBody(1) As SldWorks.Body2
Public m_OwnBody(1) As SldWorks.Body2
'>20080826>
Public m_tmpBodyForLine(1) As SldWorks.Body2
'<20080826<
Public m_TubeRec As CTubeRecover
'>20080823>
Public m_WireBody() As SldWorks.Body2
'<20080823<
Public SolidWorksID As String
Sub main()
Dim pApp As Object
Dim pModel As SldWorks.ModelDoc2
Dim strTemp As String
Dim lngResult As Long
If CheckSheetWorks() = False Then Exit Sub
Dim pId As New GetSolidWorksID
SolidWorksID = pId.main
'm_RegKey = GetRegBaseDir() & m_EachKey
LoadResources
LoadLastValueFromReg
Set pApp = CreateObject(SolidWorksID)
Dim pbRet As Boolean
pbRet = GetFilePathAndName(pApp.GetCurrentMacroPathName, m_IconsPath, strTemp, True)
m_IconsPath = m_IconsPath + "Icons" + strTemp + ""
Set pModel = pApp.ActiveDoc
If pModel Is Nothing Then
Call MsgBox(resErr0005, vbOKOnly, resTitle)
Exit Sub
End If
If pModel.GetType = swDocPART Then
m_IsPartMode = True
ElseIf pModel.GetType = swDocASSEMBLY Then
m_IsPartMode = False
Dim pAssy As SldWorks.AssemblyDoc
Set pAssy = pModel
pAssy.ResolveAllLightWeightComponents False
Else
Call MsgBox(resErr0005, vbOKOnly, resTitle)
Exit Sub
End If
NeedsRebuild True
Set m_swPage = New PropMgr
m_swPage.Show False
End Sub
Function ExecuteCommand(iExType As Long)
SaveLastValueFromReg
m_swPage.exec iExType, m_vFeats, m_vSketchs
End Function
Function ExecuteCommandEnd(iExType As Long)
m_swPage.ExecEnd m_vFeats, iExType
End Function
Public Function LoadLastValueFromReg()
Dim ret As Long
ret = DbGetValue(m_Angle, m_ExType)
End Function
Public Function SaveLastValueFromReg()
Dim ret As Long
ret = DbSetValue(m_Angle, m_ExType)
End Function
Public Function NeedsRebuild(bnFlag As Boolean) As Boolean
Dim pApp As Object
Dim pModel As SldWorks.ModelDoc2
Dim lnUp As Long
Set pApp = CreateObject(SolidWorksID)
Set pModel = pApp.ActiveDoc
lnUp = pModel.GetUpdateStamp
NeedsRebuild = True
If bnFlag Then
m_UpdateStamp = lnUp
Else
If m_UpdateStamp <> lnUp Then NeedsRebuild = False
End If
End Function |
|
发表于 2012-9-18 08:19:00
QQ好友和群
QQ空间
腾讯微博
腾讯朋友
收藏
转播
教程|习题|模型|技巧
点赞
拍砖
鲁公网安备 37028502190335号