solidworks二次开发全教程系列

solidworks二次开发全教程系列
solidworks二次开发-01-录制一个宏
第一步：
我们需要自己录制一个宏，然后看看程序产生了什么代码。

当初学习excel时候就是这么干的。

只是，solidworks要复杂一些，直接录制的宏不能使用，需要做一些调整。

在没有经验的时候我们最好按照下面的建议来做。

Edit or Debug SolidWorks Macro
Edit or debug SolidWorks macros using Microsoft VBA. 使用Microsoft VBA编辑或调试宏
To edit or debug a SolidWorks macro:
Click Edit Macro on the Macro toolbar, or click Tools, Macro, Edit.
NOTES: 注意：
To automatically edit a macro after recording it, click Tools, Options, Systems Options. On the General tab, select Automatically edit macro after recording and click OK. This setting is persistent across SolidWorks sessions.
此选项Automatically edit macro after recording 顾名思义是在记录宏完毕后自动打开编辑界面。

If you recently edited the macro, you can select it from the menu when you click Tools, Macro. This menu lists the last nine macros that you edited.
已经编辑了宏，菜单中会有最近的9个宏程序列表供选择。

In the dialog box, select a macro file (.swp) and click Open. 选择一个宏swp文件
NOTE: You can also edit .swb files, which are older-style SolidWorks macro files. When you run or edit a .swb file, it is automatically converted to a .swp file. 旧的宏文件后缀为swb，你也可以打开swb，那么会自动保存为swp。

Edit or debug the macro. If it is a new macro, be sure to:如果是新的宏
Delete extra lines of code: 删除一些多余的代码：
The following variables are declared automatically in a SolidWorks macro. Delete any variables not used in the macro. 这些对象的声明是自动产生的，可以将没用的删除Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim FeatureData As Object
Dim Feature As Object
Dim Component As Object
Delete all lines of code that change the view. 删除切换试图的代码
译者注：像这样的Part.ActiveView().RotateAboutCenter 0.0662574, 0.0346621 无情的删掉吧Delete all ModelDocExtension::SelectByID2 calls appearing immediately before ModelDoc2::ClearSelection2 calls. However, do not delete ModelDocExtension::SelectByID2 calls appearing immediately after ModelDoc2::ClearSelection2 calls.
Delete all ModelDoc2::ClearSelection2 calls appearing immediately before ModelDocExtension::SelectByID2.
solidworks二次开发-02-用来访问特征的两个API
来学习两个api：
SelectByID2和GetSelectedObject5。

这两个函数，第一个通过给出对象的name选择对象。

第二个通过启用程序前已经选择的索引得到对象。

看下面程序：
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim Model As ModelDoc2
Dim feature As feature
Dim boolstatus As Variant
Sub main()
Set swApp = Application.SldWorks
Set Model = swApp.ActiveDoc
' 选择叫"拉伸1"的特征
boolstatus = Model.Extension.SelectByID2("拉伸1", "BODYFEATURE", 0, 0, 0, False, 0, Nothing, swSelectOptionDefault)
'主要就是这一句话，在写Option Explicit后函数的最后一个参数swSelectOptionDefault可以使用0来代替
' If the selection was successful, that is, "Extrude1" was
' selected and it is a "BODYFEATURE", then get that feature; otherwise,
' indicate failure
If boolstatus = True Then '如果有“拉伸1”这个特征下面的代码将其选中Dim SelMgr As SelectionMgr
Set SelMgr = Model.SelectionManager
Set feature = SelMgr.GetSelectedObject5(1) '此处使用一个索引来得到特征
Debug.Print
Else
Debug.Print "Error"
End If
End Sub
最后列出这两个函数的VB语法：
ModelDocExtension::SelectByID2
Description
This method selects the specified entity.
Syntax (OLE Automation)
retval = ModelDocExtension.SelectByID2 ( Name, Type, X, Y, Z, Append, Mark, Callout. SelectOption )
Input:
(BSTR) Name
Name of object to select or an empty string
Input:
(BSTR) Type
Type of object (uppercase) as defined in swSelectType_e or an empty string
Input:
(double) X
X selection location or 0
Input:
(double) Y
Y selection location or 0
Input:
(double) Z
Z selection location or 0
Input:
(V ARIANT_BOOL) Append
If...
And if entity is...
Then...
TRUE
Not already selected
The entity is appended to the current selection list
Already selected
The entity is removed from the current selection list
FALSE
Not already selected
The current selection list is cleared, and then the entity is put on the list Already selected
The current selection list remains the same
Input:
(long) Mark
Value that you want to use as a mark; this value is used by other functions that require ordered selection
Input:
(LPCALLOUT) Callout
Pointer to the associated callout
Input:
(long) SelectOption
Selection option as defined in swSelectOption_e (see Remarks)
Output:
(V ARIANT_BOOL) retval
TRUE if item was successfully selected, FALSE if not
SelectionMgr::GetSelectedObject5
Description
This method gets the selected object.
Syntax (OLE Automation)
retval = SelectionMgr.GetSelectedObject5 ( AtIndex )
Input:
(long) AtIndex
Index position within the current list of selected items, where AtIndex ranges from 1 to SelectionMgr::GetSelectedObjectCount
Output:
(LPDISPATCH) retval
Pointer to the Dispatch object as defined in swSelType_e; NULL may be returned if type is not supported or if nothing is selected
solidworks二次开发-03-访问特征数据
'coder arden
'filename : getchoosed.swp
'date :2005-03-22
'used to get the simple hole infomation dep & dia
'finished lucky !!
'------------------------------------------------------------
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim Model As ModelDoc2
Dim curfeature As feature
Dim boolstatus As Boolean
Dim featdata As SimpleHoleFeatureData2 '声明一个简单直孔对象
Dim component As Component2
Dim dep As Double
Dim dia As Double
Dim SelMgr As SelectionMgr
Dim ncount As Integer
Sub getselected()
Set swApp = Application.SldWorks
Set Model = swApp.ActiveDoc
Set SelMgr = Model.SelectionManager
Set curfeature = SelMgr.GetSelectedObject5(1) '得到当前选中的第一个特征MsgBox
Set featdata = curfeature.GetDefinition '得到特征的定义
boolstatus = featdata.AccessSelections(Model, component) ' 可以对数据进行访问了
ncount = featdata.GetFeatureScopeBodiesCount
MsgBox ncount
dep = featdata.Depth
dia = featdata.Diameter
MsgBox dia & "*" & dep
'MsgBox "error arden" '在solidworks中可以使用swAPP.sendmsgtouser2
'featdata.ReleaseSelectionAccess
Model.Save
Model.EditRebuild
End Sub
**********************************************
上面程序运行前，假设你选择了一个简单直孔特征。

然后得到这个孔德一些参数。

孔深、直径等。

solidworks的API虽然是e文的。

介绍的还算详细，并且有很多的example。

大家可以多看看代码。

要访问一个特征，需要经历这样的步骤：
定义一个特征对象：dim....as ...
得到这个特征：比如使用GetSelectedObject5 还有SelectebyID等...
得到定义：GetDefinition
进行访问：AccessSelections
上面的程序没有if选择的容错机制，需要添加上。

solidworks二次开发-04-修改数据
上次已经可以访问特征的各参数了，今天我们来修改它：
要修改前面的步骤不能少，当我们已经可以读取一些特征时，我们就可以给他设定一些值。

当然有时需要调用特定的参数。

solidworks是ole和com的，所以要习惯这样。

在修改完特征后需要调用函数modifydefinition()来实现变化。

我们给一个例子，这个例子比前面的都要全面，它有很好的容错引导机制，可以直接拿来成为一个稳定的宏程序。

This example doubles the length of the base extrude.这个例子将拉伸凸台的长度增加一倍
Dim swApp As SldWorks.SldWorks
Dim Model As ModelDoc2
Dim Component As Component2
Dim CurFeature As feature
Dim isGood As Boolean
' Will become an ExtrudeFeatureData Object
Dim FeatData As Object
Dim Depth As Double
Dim SelMgr As SelectionMgr
Sub doubleBE()
}}--> }}-->Set swApp = CreateObject("sldWorks.application")
}}--> }}-->Set Model = swApp.ActiveDoc
}}--> }}-->' Make sure that the active document is a part
}}--> }}-->If Model.GetType <> swDocPART And Model.GetType <> swDocASSEMBL Y Then
‘这里的swDocPART 、swDocASSEMBL Y 我的环境没有通过。

我使用msgbox Model.GetType 的笨办法得到整数为1和2
}}--> }}-->Msg = "Only Allowed on Parts or Assemblies" ' Define message }}--> }}-->Style = vbOKOnly ' OK Button only
}}--> }}-->Title = "Error" ' Define title
}}--> }}-->Call MsgBox(Msg, Style, Title) ' Display error message
}}--> }}-->Exit Sub ' Exit this program
}}--> }}-->End If
}}-->
}}-->
}}--> }}-->' Get the Selection Manager
}}--> }}-->Set SelMgr = Model.SelectionManager
}}-->
}}-->
}}--> }}-->' Get the selected object (first in the group if there are more than one) }}--> }}-->' Note that at this point CurFeature is just a Feature Object
}}--> }}-->Set CurFeature = SelMgr.GetSelectedObject3(1)
}}--> }}-->If CurFeature Is Nothing Then
}}--> }}-->' Tell the user that nothing is selected
}}--> }}-->swApp.SendMsgToUser2 "Please select the Base-Extrude", swMbWarning, swMbOk
}}--> }}-->Exit Sub
}}--> }}-->End If
}}--> }}-->' Check the feature's type name
}}--> }}-->' Make sure it is an extrusion
}}--> }}-->If Not CurFeature.GetTypeName = swTnExtrusion Then
’在这里使用swTnExtrusion我的环境没有通过，我改成了Extrusion才ok
}}--> }}-->swApp.SendMsgToUser2 "Please select the Base-Extrude", swMbWarning, swMbOk
}}--> }}-->Exit Sub
}}--> }}-->End If
}}--> }}-->' Get the Extrusion's Feature Data
}}--> }}-->Set FeatData = CurFeature.GetDefinition
}}-->
}}-->
}}--> }}-->' Get the access selections for the feature data
}}--> }}-->' Note that Component is NULL when accessing the selections of a standalone part. }}--> }}-->If we were calling AccessSelections from within an assembly, then model would refer to the top-level document in the assembly and component would refer to the actual part.
}}--> }}-->isGood = FeatData.AccessSelections(Model, Component)
}}-->
}}-->
}}--> }}-->' Inform the user of an error
}}--> }}-->If Not isGood Then
}}--> }}-->swApp.SendMsgToUser2 "Unable to obtain access selections", swMbWarning, swMbOk
}}--> }}-->Exit Sub
}}--> }}-->End If
}}-->
}}-->
}}--> }}-->' Make sure the user has selected the base extrude
}}--> }}-->If Not FeatData.IsBaseExtrude Then
}}--> }}-->swApp.SendMsgToUser2 "Please select the Base-Extrude", swMbWarning, swMbOk
}}--> }}-->FeatData.ReleaseSelectionAccess
}}--> }}-->Exit Sub
}}--> }}-->End If
}}-->
}}-->
}}--> }}-->' Change the depth of this extrusion to double its previous depth
}}--> }}-->Depth = FeatData.GetDepth(True)
}}--> }}-->FeatData.SetDepth True, Depth * 2
}}-->
}}-->
}}--> }}-->' Implement the changes to the feature
}}--> }}-->isGood = CurFeature.ModifyDefinition(FeatData, Model, Component)
}}-->
}}-->
}}--> }}-->' If the modify definition failed
}}--> }}-->If Not isGood Then
}}--> }}-->swApp.SendMsgToUser2 "Unable to modify feature data", swMbWarning, swMbOk
}}--> }}-->' Release the AccessSelections
}}--> }}-->FeatData.ReleaseSelectionAccess
}}--> }}-->End If
}}-->
}}-->
End Sub
如果出现特征出现“退回”状态，我现在还没有找到问题的原因，只能在代码执行到最后调用
Model.Save
Model.Rebuild
这两个函数来自动更新。

Solidworks二次开发---05--装配体中插入零部件
在往装配体中插入零部件时，我们使用addcomponent 函数。

如果需要选定零部件的配置，则需要使用addcomponent4。

先学习下语法：
addcomponent4：
retval = AssemblyDoc.AddComponent4 ( compName, configName, x, y, z)
Input: (BSTR) compName Path name of a loaded part or assembly to add as a component
Input: (BSTR) configName Name of the configuration from which to load the component
Input: (double) x X coordinate of the component center
Input: (double) y Y coordinate of the component center
Input: (double) z Z coordinate of the component center
Output: (LPCOMPONENT2) retval Pointer to the Component2 object
需要注意的是：参数1为文件的全名（包括路径）；参数2为文件的配置名称；当函数执行成功购返回一个指向该零件的指针。

于是我们可以如下写一个小程序，用来给装配体中插零件：
‘filename:insertPart.swp
‘write by
arden
2005-4-4
‘this function add a part called “零件1.SLDPRT”in CurrentWorkingDirectory
‘precondition is there has a part document called “零件 1.SLDPRT”in CurrentWorkingDirectory
‘and it has a configuration called “配置1”
Dim swApp As SldWorks.SldWorks
Dim Model As ModelDoc2
Dim pth As String
Dim strpath As String
Sub insertPart()
Set swApp = Application.SldWorks
strpath = swApp.GetCurrentWorkingDirectory ‘当前工作路径
Set Model = swApp.ActiveDoc
pth = strpath & "零件1.SLDPRT" ‘得到文件的FULLPATH全名
Model.AddComponent4 pth, "配置1", 0, 0, 0 ‘添加零部件
End Sub
然而，这个程序比不是想象中那么好用。

为什么呢？？回头看addcomponent4的remark，上面这样写：
The specified file must be loaded in memory. A file is loaded into memory when you load the file in your
SolidWorks session (SldWorks::OpenDoc6) or open an assembly that already contains the file.
就是说你想指定的插入的文件必须在调用函数之前已经在内存中加载了。

不习惯，你就不能直接打开多简单，没办法，我还没有找到好的方法，只能按人家的来：
看看下面的函数Opendoc6，它打开一个文档：
Opendoc6：
retval = SldWorks.OpenDoc6 ( filename, type, options, configuration, &Errors, &Warnings )
Input: (BSTR) Filename Document name or full path if not in current directory, including extension
Input: (long) Type Document type as defined in swDocumentTypes_e
Input: (long) Options Mode in which to open the document as defined in swOpenDocOptions_e
Input: (BSTR) Configuration Model configuration in which to open this document：
Applies to parts and assemblies, not drawings
If this argument is empty or the specified configuration is not present in the model,
the model is opened in the last-used configuration.
Output: (long) Errors Load errors as defined in swFileLoadError_e
Output: (long) Warnings Warnings or extra information generated during the open operation as defined in swFileLoadWarning_e
Return: (LPDISPA TCH) retval Pointer to a Dispatch object, the newly loaded ModelDoc2, or NULL if failed to open
这个函数参数1就是文档的全名，参数2是要插入的类型描述，其中0123分别表示：
0 swDocNONE：不是sw文件
1 swDocPART：零件
2 swDocASSEMBLY：装配体
3 swDocDRAWING：工程图
如果想使用swDocNONE，需要定义：
Public Enum swDocumentTypes_e
}--> }-->swDocNONE = 0
}--> }-->swDocPART= 1
}--> }-->swDocASSEMBL Y = 2
swDocDRAWING=3
End Enum
参数3是打开文档的模式，一般我们就选择swOpenDocOptions_Silent 用0 表示，当然还有只读、只看等选项
参数4是打开选项，一般置空
后面是两个OutPut，用来显示错误打开时的提示
函数返回一个指向打开文件的指针。

按照上面的要求我们在向装配体中插入一个零部件时，需要这样步骤：
1、得到装配体
2、使用opendoc6打开需要插入的零件
3、使用addcomponent4插入零件到装配体
我们上面的程序需要这样来修改一下，添加了一个打开文档的函数：
' ****************************************************************************** ' insertpart 03/21/05 by
arden
'插入零件1
'前提条件：在装配体所在文件夹中有零件“零件1”存在，并且零件1有配置“配置1”' ****************************************************************************** Dim swApp As SldWorks.SldWorks
Dim Model As ModelDoc2
Dim YSBmodel As ModelDoc2
Dim pth As String
Dim strpath As String
Dim nErrors As Long
Dim nWarnings As Long
Sub insertpart()
Set swApp = Application.SldWorks
strpath = swApp.GetCurrentWorkingDirectory
Set Model = swApp.ActiveDoc
pth = strpath & "零件1.SLDPRT"
openYSB (pth) ‘在添加零部件之前，先打开它Model.AddComponent4 pth, "配置1", 0, 0, 0
End Sub
'这个函数打开零件1
Sub openpart(ByVal pth As String)
Dim path As String
Dim newswapp As SldWorks.SldWorks
Set newswapp = Application.SldWorks
path = pth
Set YSBmodel = newswapp.OpenDoc6(path, 1, swOpenDocOPtions_Silent, "", nErrors, nWarnings)
YSBmodel.Visible = False ‘我不想看到零件1
End Sub
Solidworks二次开发—06—在装配体中添加配合
折腾了三天终于完成了计划中的功能模块。

在一个装配体中自动判断插入合适的零件，并添加配合。

在前面几篇文章中我已经基本上说明了如何得到零部件的数据信息、如何插入零部件、如何得到已经选择的特征等。

下面只介绍怎样进行配合
在做配合时，需要经常选择到零件的面、线等，这是一个问题，还有就是介绍一下addmate2函数的使用：
一般进行配合我们按照下面的次序来进行：
1-ModelDoc.ClearSelection2 ‘取消所有选择
2-选择需要配合的实体（entity）
3-使用AddMate2函数进行配合
4-再次使用ModelDoc.ClearSelection2 ‘取消所有选择
主要的问题在于如何选择合适的面：
由于面的命名没有什么规律，很多时候是程序自动来命名的，这样，不方便使用selectbyID
来选择，我也不想使用坐标值来选择一个面，那样做更加糟糕。

在得到一个组件（component）或者一个特征（feature）时，我们有getfaces、getfirstface、getnextface等方法，我们可以使用这些方法遍历一个组件或特征等的各个面，来达到选择面的目的，看下面程序：
Private Function selectface(dcom As ponent2, tp As Integer) As Boolean
Set swdowelbody = dcom.GetBody()
If swdowelbody Is Nothing Then '错误处理
MsgBox "选择零件失败"
selectface = False
Exit Function
End If
Set swDCface = swdowelbody.GetFirstFace ‘得到第一个面
Do While Not swDCface Is Nothing ‘遍历各个面
Set swDsurface = swDCface.GetSurface ‘得到表面对象
If swDsurface.IsCylinder Then ‘如果是圆柱面
If tp = 0 Then 'means cylinder
Set swDEnt = swDCface
swDEnt.Select4 True, selDdata
selectface = True
Exit Function
End If
Else ‘如果是其它，当然实际中我们可能需要使用select来定义好多分支
If tp = 1 Then 'means plane
Set swDEnt = swDCface
swDEnt.Select4 True, selDdata
selectface = True
Exit Function
End If
End If
Set swDCface = swDCface.GetNextFace
Loop
End Function
此函数接受两个参数，第一个是一个component对象，第二个用来标识选择类型：0表示圆柱面，1表示平面。

此函数运行完成后将选择指定组件的指定类型的一个面。

需要注意的是我们需要在判断面类型时候需要转换到surface对象。

而且选择需要定义一个entity对象，用来select4，达到选择的目的。

可能这个过程有些复杂，大家按照这个顺序多测试几次，就明白了它的工作原理。

上面的函数写的并不好，是我从我的工程中截取的一段。

下面介绍一下addmate2函数：
Syntax (OLE Automation) OLE语法：
pMateObjOut = AssemblyDoc.AddMate2 ( mateTypeFromEnum, alignFromEnum, flip, distance, distAbsUpperLimit, distAbsLowerLimit, gearRatioNumerator, gearRatioDenominator, angle, angleAbsUpperLimit, angleAbsLowerLimit, errorStatus )
参数：
Input:
(long) mateTypeFromEnum
Type of mate as defined in swMateType_e
配合类型
Input:
(long) alignFromEnum
Type of alignment as defined in swMateAlign_e 对齐选项
Input:
(V ARIANT_BOOL) flip
TRUE to flip the component, FALSE otherwise
是否翻转
Input:
(double) distance
Distance value to use with distance or limit mates
距离
Input:
(double) distAbsUpperLimit
Absolute maximum distance value (see Remarks)
距离限制max
Input:
(double) distAbsLowerLimit
Absolute minimum distance value (see Remarks) 距离限制min
Input:
(double) gearRatioNumerator
Gear ratio numerator value for gear mates
齿轮配合分子值
Input:
(double) gearRatioDenominator
Gear ratio denominator value for gear mates
齿轮配合分母值
Input:
(double) angle
Angle value to use with angle mates
角度
Input:
(double) angleAbsUpperLimit
Absolute maximum angle value
角度限制max
Input:
(double) angleAbsLowerLimit
Absolute minimum angle value
角度限制min
Output:
(long) errorStatus
Success or error as defined by swAddMateError_e
错误报告
Return:
(LPMA TE2) pMateObjOut
Pointer to the Mate2 object
返回指向配合的指针
Remarks
To specify a distance mate without limits, set the distAbsUpperLimit and distAbsLowerLimit arguments equal to the distance argument's value.
指定一个没有限制的距离，设定距离限制的最大、最小值和距离值相等
If mateTypeFromEnum is swMateDISTANCE or swMateANGLE when the mate is applied to the closest position that meets the mate condition specified by distance or angle, then setting flip to TRUE moves the assembly to the other possible mate position.
如果是距离或角度配合，配合将从符合条件的最近端进行配合，我们可以设定flip为true，改变配合至另一个合适的位置
Use:使用配合的步骤
ModelDoc2::ClearSelection2(V ARIANT_TRUE) before selecting entities to mate.
ModelDocExtension::SelectByID2 with Mark = 1 to select entities to mate.
ModelDoc2::ClearSelection2(V ARIANT_TRUE) after the mate is created.
If mateTypeFromEnum is swMateCAMFOLLOWER, then use a selection mark of 8 for the cam-follower face.
如果配合类型为凸轮，在表面标示8. 注：这个我也不太明白哈哈
If nothing is preselected, then errorStatus is swAddMateError_IncorrectSeletions and pMateObjOut is NULL/Nothing.
如果实现没有限定实体来配合，将会抱错swAddMateError_IncorrectSeletions，函数返回NULL或者Nothing
上面就是API帮助所说的话，下面给出一段示例程序，假设之前我们已经选择了两个半径一样的圆柱面，那么我们来定义一个同心配合：
Set swmatefeat = swassy.AddMate2(1, 0, False, 0, 0, 0, 0, 0, 0, 0, 0, nErrors)
其中的Dim swassy As SldWorks.AssemblyDoc
Dim swmatefeat As Object
注：在编程中有时候不能实现确定一个对象的类型，我们可以声明一个Object对象，让VB 自己去匹配。

但这样做是影响了效率。

要完成一个距离或者角度要麻烦一些，就像上面的remark中说明的：
Set swmatefeat = swassy.AddMate2(5, 1, True, 0.001, 0.001, 0.001, 0, 0, 0, 0, 0, nErrors)
在这里我们需要将min和max都设置成与距离值相等，要不然配合会认为我们设定了高级配合中的限制条件，会报错。

并且第三个参数和第二个参数需要按实际情况来确定。

最后我们列出AddMate2的类型：
swMateType_e
‘Specifies values for assembly-mate information.
swMateCOINCIDENT 0 重合
swMateCONCENTRIC 1 同心
swMatePERPENDICULAR 2 垂直
swMatePARALLEL 3 平行
swMateTANGENT 4 相切
swMateDISTANCE 5 距离
swMateANGLE 6 角度
swMateUNKNOWN 7 未知
swMateSYMMETRIC 8 对称
swMateCAMFOLLOWER 9 凸轮
swMateGEAR 10 齿轮
Solidworks二次开发—07—控制草图对象
Get All Elements of Sketch Example (VB)
Solidwork中对草图的控制，下面的例子很详细。

特征下的草图在solidwork中其实是特征的子特征，我们可以对特征进行GetFirstSubFeature、及GetNextSubFeature得到。

如果有需要大家可以从中找到对直线、弧线、圆等对象的操作。

代码是solidworks的示例文件，里面充斥了debug.print，只是向用户显示程序执行的结果。

This example shows how to get all of the elements of a sketch.
'---------------------------------------------
' Preconditions: Model document is open and a sketch is selected.
' Postconditions: None
'---------------------------------------------
Option Explicit
Public Enum swSkSegments_e
swSketchLINE = 0
swSketchARC = 1
swSketchELLIPSE = 2
swSketchSPLINE = 3
swSketchTEXT = 4
swSketchPARABOLA = 5
End Enum
Sub ProcessTextFormat _
( _
swApp As SldWorks.SldWorks, _
swModel As SldWorks.ModelDoc2, _
swTextFormat As SldWorks.textFormat _ )
Debug.Print " BackWards = " & swTextFormat.BackWards
Debug.Print " Bold = " & swTextFormat.Bold
Debug.Print " CharHeight = " & swTextFormat.CharHeight
Debug.Print " CharHeightInPts = " & swTextFormat.CharHeightInPts
Debug.Print " CharSpacingFactor = " & swTextFormat.CharSpacingFactor
Debug.Print " Escapement = " & swTextFormat.Escapement
Debug.Print " IsHeightSpecifiedInPts = " & swTextFormat.IsHeightSpecifiedInPts
Debug.Print " Italic = " & swTextFormat.Italic
Debug.Print " LineLength = " & swTextFormat.LineLength Debug.Print " LineSpacing = " & swTextFormat.LineSpacing
Debug.Print " ObliqueAngle = " & swTextFormat.ObliqueAngle
Debug.Print " Strikeout = " & swTextFormat.Strikeout
Debug.Print " TypeFaceName = " & swTextFormat.TypeFaceName
Debug.Print " Underline = " & swTextFormat.Underline
Debug.Print " UpsideDown = " & swTextFormat.UpsideDown
Debug.Print " Vertical = " & swTextFormat.Vertical
Debug.Print " WidthFactor = " & swTextFormat.WidthFactor
Debug.Print ""
End Sub
Function TransformSketchPointToModelSpace _
( _
swApp As SldWorks.SldWorks, _
swModel As SldWorks.ModelDoc2, _
swSketch As SldWorks.sketch, _
swSkPt As SldWorks.SketchPoint _
) As SldWorks.MathPoint
Dim swMathUtil As SldWorks.MathUtility
Dim swXform As SldWorks.MathTransform Dim nPt(2) As Double
Dim vPt As Variant
Dim swMathPt As SldWorks.MathPoint
nPt(0) = swSkPt.x: nPt(1) = swSkPt.y: nPt(2) = swSkPt.z vPt = nPt
Set swMathUtil = swApp.GetMathUtility
Set swXform = swSketch.ModelToSketchTransform
Set swXform = swXform.Inverse
Set swMathPt = swMathUtil.CreatePoint((vPt))
Set swMathPt = swMathPt.MultiplyTransform(swXform)
Set TransformSketchPointToModelSpace = swMathPt
End Function
Sub ProcessSketchLine _
( _
swApp As SldWorks.SldWorks, _
swModel As SldWorks.ModelDoc2, _
swSketch As SldWorks.sketch, _
swSkLine As SldWorks.SketchLine _
)
Dim swStartPt As SldWorks.SketchPoint
Dim swEndPt As SldWorks.SketchPoint Dim swStartModPt As SldWorks.MathPoint
Dim swEndModPt As SldWorks.MathPoint
Set swStartPt = swSkLine.GetStartPoint2
Set swEndPt = swSkLine.GetEndPoint2
Set swStartModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swStartPt)
Set swEndModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swEndPt)
Debug.Print " Start (sketch) = (" & swStartPt.x * 1000# & ", " & swStartPt.y * 1000# & ", " & swStartPt.z * 1000# & ") mm"
Debug.Print " Start (model ) = (" & swStartModPt.ArrayData(0) * 1000# & ", " & swStartModPt.ArrayData(1) * 1000# & ", " & swStartModPt.ArrayData(2) * 1000# & ") mm"
Debug.Print " End (sketch) = (" & swEndPt.x * 1000# & ", " & swEndPt.y * 1000# & ", " & swEndPt.z * 1000# & ") mm"
Debug.Print " End (model ) = (" & swEndModPt.ArrayData(0) * 1000# & ", " & swEndModPt.ArrayData(1) * 1000# & ", " & swEndModPt.ArrayData(2) * 1000# & ") mm"
End Sub
Sub ProcessSketchArc _
( _
swApp As SldWorks.SldWorks, _
swModel As SldWorks.ModelDoc2, _
swSketch As SldWorks.sketch, _
swSkArc As SldWorks.SketchArc _
)
Dim swStartPt As SldWorks.SketchPoint
Dim swEndPt As SldWorks.SketchPoint Dim swCtrPt As SldWorks.SketchPoint Dim vNormal As Variant
Dim swStartModPt As SldWorks.MathPoint
Dim swEndModPt As SldWorks.MathPoint
Dim swCtrModPt As SldWorks.MathPoint
Set swStartPt = swSkArc.GetStartPoint2
Set swEndPt = swSkArc.GetEndPoint2
Set swCtrPt = swSkArc.GetCenterPoint2
Set swStartModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swStartPt)
Set swEndModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swEndPt)
Set swCtrModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swCtrPt)
vNormal = swSkArc.GetNormalVector
Debug.Print " Start (sketch) = (" & swStartPt.x * 1000# & ", " & swStartPt.y * 1000# & ", " & swStartPt.z * 1000# & ") mm"
Debug.Print " Start (model ) = (" & swStartModPt.ArrayData(0) * 1000# & ", " & swStartModPt.ArrayData(1) * 1000# & ", " & swStartModPt.ArrayData(2) * 1000# & ") mm"
Debug.Print " End (sketch) = (" & swEndPt.x * 1000# & ", " & swEndPt.y * 1000# & ", " & swEndPt.z * 1000# & ") mm"
Debug.Print " End (model ) = (" & swEndModPt.ArrayData(0) * 1000# & ", " & swEndModPt.ArrayData(1) * 1000# & ", " & swEndModPt.ArrayData(2) * 1000# & ") mm"
Debug.Print " Center(sketch) = (" & swCtrPt.x * 1000# & ", " & swCtrPt.y * 1000# & ", " & swCtrPt.z * 1000# & ") mm"
Debug.Print " Center(model ) = (" & swCtrModPt.ArrayData(0) * 1000# & ", " & swCtrModPt.ArrayData(1) * 1000# & ", " & swCtrModPt.ArrayData(2) * 1000# & ") mm"
Debug.Print " Radius = " & swSkArc.GetRadius * 1000# & " mm"
Debug.Print " IsCircle = " & CBool(swSkArc.IsCircle)
Debug.Print " Rot dirn = " & swSkArc.GetRotationDir
End Sub
Sub ProcessSketchEllipse _
( _
swApp As SldWorks.SldWorks, _
swModel As SldWorks.ModelDoc2, _
swSketch As SldWorks.sketch, _
swSkEllipse As SldWorks.SketchEllipse _
)
Dim swStartPt As SldWorks.SketchPoint
Dim swEndPt As SldWorks.SketchPoint Dim swCtrPt As SldWorks.SketchPoint Dim swMajPt As SldWorks.SketchPoint Dim swMinPt As SldWorks.SketchPoint
Dim swStartModPt As SldWorks.MathPoint
Dim swEndModPt As SldWorks.MathPoint
Dim swCtrModPt As SldWorks.MathPoint
Dim swMajModPt As SldWorks.MathPoint
Dim swMinModPt As SldWorks.MathPoint
Set swStartPt = swSkEllipse.GetStartPoint2
Set swEndPt = swSkEllipse.GetEndPoint2
Set swCtrPt = swSkEllipse.GetCenterPoint2
Set swMajPt = swSkEllipse.GetMajorPoint2
Set swMinPt = swSkEllipse.GetMinorPoint2
Set swStartModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swStartPt)
Set swEndModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swEndPt)
Set swCtrModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swCtrPt)
Set swMajModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swMajPt)
Set swMinModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swMinPt)
Debug.Print " Start (sketch) = (" & swStartPt.x * 1000# & ", " & swStartPt.y * 1000# & ", " & swStartPt.z * 1000# & ") mm"
Debug.Print " Start (model ) = (" & swStartModPt.ArrayData(0) * 1000# & ", " & swStartModPt.ArrayData(1) * 1000# & ", " & swStartModPt.ArrayData(2) * 1000# & ") mm"
Debug.Print " End (sketch) = (" & swEndPt.x * 1000# & ", " & swEndPt.y * 1000# & ", " & swEndPt.z * 1000# & ") mm"
Debug.Print " End (model ) = (" & swEndModPt.ArrayData(0) * 1000# & ", " & swEndModPt.ArrayData(1) * 1000# & ", " & swEndModPt.ArrayData(2) * 1000# & ") mm"
Debug.Print " Center(sketch) = (" & swCtrPt.x * 1000# & ", " & swCtrPt.y * 1000# & ", " & swCtrPt.z * 1000# & ") mm"。