SolidWorks二次开发VB多多互动

design100 · 发表于 2017-4-20 09:22:28

你们还在用SolidWorksVBA写程序吗?(真心不方便)我已改用Visual Studio 2012写法！
有问题可多多互动，请发文本！
补充内容 (2017-4-21 09:27):
Dim swModel As ModelDoc2
Dim swFeat As Feature
Dim FeatType As String '宣告特征类型
Dim RefPlaneName(2) As String
Dim OriginPointName As String3
'在不同的模板,获取参考基准...

hehongwang723 · 发表于 2017-4-20 09:46:35

qh8891 · 发表于 2017-4-20 21:53:34

可以发些例　子，大家一起学习学习．．

design100 · 发表于 2017-4-21 09:28:28

Dim swModel As ModelDoc2
Dim swFeat As Feature
Dim FeatType As String '宣告特征类型
Dim RefPlaneName(2) As String
Dim OriginPointName As String3
'在不同的模板,获取参考基准面和原点名
Public Sub GetRefPlaneName()
      swModel = swApp.ActiveDoc    '返回当前活动的文件
      swFeat = swModel.FirstFeature    '获得特征管理器的第一个特征
      Do  '循环
         FeatType = swFeat.GetTypeName             '获得特征类型
         If FeatType = "RefPlane" Then             '如果特征类型是参考面的话
            RefPlaneName(0) = swFeat.Name          '获得前视特征名
            swFeat = swFeat.GetNextFeature       '到下一个特征
            RefPlaneName(1) = swFeat.Name          '获得上视特征名
            swFeat = swFeat.GetNextFeature       '到下一个特征
            RefPlaneName(2) = swFeat.Name          '获得右视特征名
            swFeat = swFeat.GetNextFeature       '到下一个特征
            OriginPointName = swFeat.Name    '获得原点名,用作分析是英文还是简体中文系统
            Exit Do
         End If
         swFeat = swFeat.GetNextFeature    '到下一个特征
      Loop
End Sub

litao036 · 发表于 2017-4-21 10:02:06

经典案例图书

看看怎么样

design100 · 发表于 2017-4-22 08:48:03

'去掉后缀名
Public Sub ParseAssemblyName()
      Dim AssemblyTitle As String
      Dim CopyToPath As String
      Dim StrName As String()
      Dim AsseBlyName As String = ""
      AsseBlyName = swModel.GetTitle
      AssemblyTitle = AsseBlyName
      '如果没有后缀名就接后缀名.SLDASM（这个情况是在我的电脑/工具/文件夹选项/查看/勾住隐藏已知文件类型扩展名
      If AsseBlyName.EndsWith(".SLDASM", True, culture) Then
         StrName = AsseBlyName.Split(".SLDASM, .sldasm")
         AssemblyTitle = StrName(0) '获得没有后缀名的名字
      End If
      '
      StrName = Split(swModel.GetPathName, AssemblyTitle & ".SLDASM")
      'StrName = Split(swModel.GetPathName, AsseBlyName)
      CopyToPath = StrName(0)
      '取得当前的图号
      StrName = AssemblyTitle.Split("-"c)
      'MoNOJSQ = StrName(0) & "-"
      If CopyToPath = "" Then
         MessageBox.Show("请先存档才可运行！", "提醒", MessageBoxButtons.YesNo, MessageBoxIcon.Exclamation)
      End If
End Sub

design100 · 发表于 2017-4-22 10:48:57

经典案例图书

开料，绘制3D草图线框
'----------------------------------------------
Option Explicit
Sub main()
Dim swApp                      As SldWorks.SldWorks
Dim swModel                   As SldWorks.ModelDoc2
Dim swSelMgr                   As SldWorks.SelectionMgr
Dim swFeat                   As SldWorks.Feature
Dim vBox                      As Variant
Dim swSketchPt(8)             As SldWorks.SketchPoint
Dim swSketchSeg(12)          As SldWorks.SketchSegment
Dim bRet                      As Boolean

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swFeat = swSelMgr.GetSelectedObject5(1)

Debug.Print "Feature = " & swFeat.Name
bRet = swFeat.GetBox(vBox): Debug.Assert bRet
Debug.Print "  Pt1 = " & "(" & vBox(0) * 1000# & ", " & vBox(1) * 1000# & ", " & vBox(2) * 1000# & ") mm"
Debug.Print "  Pt2 = " & "(" & vBox(3) * 1000# & ", " & vBox(4) * 1000# & ", " & vBox(5) * 1000# & ") mm"
swModel.Insert3DSketch2 True
swModel.SetAddToDB True
swModel.SetDisplayWhenAdded False

' Draw points at each corner of bounding box
Set swSketchPt(0) = swModel.CreatePoint2(vBox(3), vBox(1), vBox(5))
Set swSketchPt(1) = swModel.CreatePoint2(vBox(0), vBox(1), vBox(5))
Set swSketchPt(2) = swModel.CreatePoint2(vBox(0), vBox(1), vBox(2))
Set swSketchPt(3) = swModel.CreatePoint2(vBox(3), vBox(1), vBox(2))
Set swSketchPt(4) = swModel.CreatePoint2(vBox(3), vBox(4), vBox(5))
Set swSketchPt(5) = swModel.CreatePoint2(vBox(0), vBox(4), vBox(5))
Set swSketchPt(6) = swModel.CreatePoint2(vBox(0), vBox(4), vBox(2))
Set swSketchPt(7) = swModel.CreatePoint2(vBox(3), vBox(4), vBox(2))

' Now draw bounding box
Set swSketchSeg(0) = swModel.CreateLine2(swSketchPt(0).X, swSketchPt(0).Y, swSketchPt(0).Z, swSketchPt(1).X, swSketchPt(1).Y, swSketchPt(1).Z)
Set swSketchSeg(1) = swModel.CreateLine2(swSketchPt(1).X, swSketchPt(1).Y, swSketchPt(1).Z, swSketchPt(2).X, swSketchPt(2).Y, swSketchPt(2).Z)
Set swSketchSeg(2) = swModel.CreateLine2(swSketchPt(2).X, swSketchPt(2).Y, swSketchPt(2).Z, swSketchPt(3).X, swSketchPt(3).Y, swSketchPt(3).Z)
Set swSketchSeg(3) = swModel.CreateLine2(swSketchPt(3).X, swSketchPt(3).Y, swSketchPt(3).Z, swSketchPt(0).X, swSketchPt(0).Y, swSketchPt(0).Z)

Set swSketchSeg(4) = swModel.CreateLine2(swSketchPt(0).X, swSketchPt(0).Y, swSketchPt(0).Z, swSketchPt(4).X, swSketchPt(4).Y, swSketchPt(4).Z)
Set swSketchSeg(5) = swModel.CreateLine2(swSketchPt(1).X, swSketchPt(1).Y, swSketchPt(1).Z, swSketchPt(5).X, swSketchPt(5).Y, swSketchPt(5).Z)
Set swSketchSeg(6) = swModel.CreateLine2(swSketchPt(2).X, swSketchPt(2).Y, swSketchPt(2).Z, swSketchPt(6).X, swSketchPt(6).Y, swSketchPt(6).Z)
Set swSketchSeg(7) = swModel.CreateLine2(swSketchPt(3).X, swSketchPt(3).Y, swSketchPt(3).Z, swSketchPt(7).X, swSketchPt(7).Y, swSketchPt(7).Z)

Set swSketchSeg(8) = swModel.CreateLine2(swSketchPt(4).X, swSketchPt(4).Y, swSketchPt(4).Z, swSketchPt(5).X, swSketchPt(5).Y, swSketchPt(5).Z)
Set swSketchSeg(9) = swModel.CreateLine2(swSketchPt(5).X, swSketchPt(5).Y, swSketchPt(5).Z, swSketchPt(6).X, swSketchPt(6).Y, swSketchPt(6).Z)
Set swSketchSeg(10) = swModel.CreateLine2(swSketchPt(6).X, swSketchPt(6).Y, swSketchPt(6).Z, swSketchPt(7).X, swSketchPt(7).Y, swSketchPt(7).Z)
Set swSketchSeg(11) = swModel.CreateLine2(swSketchPt(7).X, swSketchPt(7).Y, swSketchPt(7).Z, swSketchPt(4).X, swSketchPt(4).Y, swSketchPt(4).Z)

swModel.SetDisplayWhenAdded True
swModel.SetAddToDB False
swModel.Insert3DSketch2 True
End Sub
'----------------------------------------------

design100 · 发表于 2017-7-13 15:10:52

好好学习，天天向上！

1215956038 · 发表于 2021-4-17 21:43:03

好好学习，天天向上！

xfliu3615 · 发表于 2021-10-10 17:44:13

好多资料啊，谢谢！

jines5 · 发表于 2021-11-30 15:23:40

点赞支持一下，

zxt0824 · 发表于 2022-3-11 13:49:40

好好学习，天天向上！

		自动登录	找回密码
密码			立即注册

SolidWorks二次开发VB多多互动

最佳新人

活跃会员

热心会员

宣传达人

灌水之王

突出贡献