ryouss 发表于 2019-7-6 11:50
什麼版本測試的,顯示什麼錯誤提示?
SW2016，还没有装好
刚开始，看到最上面的代码
[*]Function SetSwPart()* V$ ~6 @ U! o" v- l"
[*]Dim SwApp As Object;q& [! u5 L.
[*]Dim SelMgr As Object, boolStatus As Boolean8 y Q+ J6 M, K: x
[*]Dim longstatus As Long, longwarnings As Long; Y# z3 A7 q' K J' ]" ?0 f5 |4 b. E3
[*]Set SwApp = GetObject(, "sldworks.application")+ n( E2 d; Y- O; _/ h9 u* Y# Y
[*]Set SetSwPart = SwApp.ActiveDoc& H) _, N7 I1 F5 a6 z, z
[*]End Function
把function看成了sub，这样就不行了。
如果是Function SetSwPart() as object就更清楚了，当然这么些也没错，就是内存多占了一点
这段相当于对象指针设置，对吧
如果“在EXCEL修改尺寸”，还有一种办法，用DDE，就是在excel中修改参数后，WS中自动就改过来了
DDE现在似乎只是用在excel中，其他地方不常见了
zmztx 发表于 2019-7-8 14:48
SW2016，还没有装好
刚开始，看到最上面的代码
難得zmztx大大能深入探討很不錯.
1. 是可以簡化去掉 Function SetSwPart()
'~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
' 操作:
' 1. 開 EXCEL文件.
' 2. 開 SW零件.
' 3. 執行 ReadSwDimensionInSldPrt().
' 4. 在EXCEL修改尺寸.
'
' 功能:
' 1. 讀取SW零件的全部尺寸,寫到 Excel.
' 2. 在Excel變動尺寸后,修改SW的零件尺寸.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim SwApp As Object
Dim boolStatus As Boolean
Dim swFeat As Object ', swSubFeat As Object
Dim swDispDim As Object, SwDim As Object
Dim Str
Dim oDic
Dim oArr1, oArr2
Sub ReadSwDimensionInSldPrt()
'讀取SW的全部尺寸
Set SwApp = Application.SldWorks
Set Part = SwApp.ActiveDoc
Set oDic = CreateObject("Scripting.Dictionary")
'*** Get active sheet in Excel
Set xl = GetObject(, "Excel.Application")
With xl.ActiveSheet
Set swFeat = Part.FirstFeature
kk = 1
Do While Not swFeat Is Nothing
Debug.Print "" + swFeat.Name
'Set swSubFeat = swFeat.GetFirstSubFeature
Set swDispDim = swFeat.GetFirstDisplayDimension
Do While Not swDispDim Is Nothing
'Set swAnn = swDispDim.GetAnnotation
Set SwDim = swDispDim.GetDimension
Str = SwDim.FullName '特徵樹名稱
oArr = Split(Str, "@")
Str = oArr(0) & "@" & oArr(1)
oDic(Str) = SwDim.GetSystemValue2("")
Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
kk = kk + 1
Loop
Set swFeat = swFeat.GetNextFeature
Loop
oArr1 = oDic.keys: oArr2 = oDic.Items
.cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"
.cells(1, 4) = "Feature name": .cells(1, 5) = "Dimension value"
For kk = 2 To UBound(oArr1) + 2
.cells(kk, 1) = kk - 2
.cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
.cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
.cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
.cells(kk, 5) = oArr2(kk - 2)
Next kk
nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
Set Part = SwApp.ActiveDoc
'依據Excel變動值修改到sw零件
For mm = 2 To nn
Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
Next mm
End With
boolStatus = Part.EditRebuild3()
MsgBox "Part size modification ends" '零件尺寸修改結束
End Sub
2. 另也可以直接寫在 EXCEL
本帖最后由 zmztx 于 2019-7-9 15:17 编辑
我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好
“58.nn = .Range("C65536").End(3).Row
你这是Excel2003？
从excel，SW的数据读进来，处理以后再写回去
以前在solidedge中，用过这种方式，发现一个问题，solidedge的数据有一个半角字符，写到excel中看不出来。费了不少时间
这事在sw中不知道有没有
页:
1
[2]