不規則容器刻度標示_巨集

scliang

做參考
有興趣討論再釋出原檔及宏
重點是用取容器高度之變量用宏取出體積,達到刻度值修正刻度尺寸.
如圖是容器高度之變量值取0.5mm之數據.

算出的容量,每刻度約有5cc以下誤差(下表單位是 mm^3)

臭臉翔

請問...梁叔做的這個也可以隨意改變外型嗎

太多不了解的，也不知道該怎麼請教

scliang

臭臉翔 發表於 2014/8/5 08:34
請問...梁叔做的這個也可以隨意改變外型嗎

太多不了解的，也不知道該怎麼請教 ...

求真精神可嘉!
萬事要有證據.

臭臉翔

scliang 發表於 2014/8/5 09:37
求真精神可嘉!
萬事要有證據.

想不通，也很好奇，什麼算式這麼神奇可以這樣做

謝謝梁叔分享，靜待高手討論了

先收藏起來慢慢思考

scliang

既然叫做"試誤法",就會牽扯到"誤差精度",
所以才設出0.1,0.2,0.25,0.5四級精度計算.

scliang

補編程做參考:

'  macro recorded on 08/05/14 by scliang'
' 叫出組件某零件的體積,並計算刻度尺寸.'
' ~~~~ 操作說明 ~~~~
' 1. 把 asm1.SLDASM 組件檔及 Part1.Part 零件檔放在  C:\Irregular vessels\ 路徑.
' 2. 開 asm1.SLDASM 組件檔 ,在 Part1 的編輯狀態稍為調整外觀尺寸(注意要開 Instant3D 才能動態拖曳點及尺寸) .
' 3. 執行 main()巨集(宏).
' 4. 在自訂表單鍵入刻度規格(本例訂為1000cc),刻度高精度定為0.1,0.2,0.25,0.5mm,4級),按"執行"鍵.
' 5. 本例刻度數定為10刻度,刻度高精度值越小刻度容量越準確,但計算也越費時(建議選0.5作測試).
' 6. 本例容器總高為150mm,最大刻度高定為140mm.
'
'---------------------------------------------

scliang

補個編程,盡然要分這麼多段(5段),真可憐 !!!???

scliang

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean

Sub run()

Dim swApp As SldWorks.SldWorks
Dim swModelDoc As SldWorks.ModelDoc2
Dim comp As Component2
Dim compbody As Variant
Dim bodyInfo As Variant
Dim val As Double
Dim params As Variant
Dim swMass As SldWorks.MassProperty
Dim errors As Long
Dim warnings As Long
Dim s(1 To 11) As Double '刻度高
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set swModelDoc = swApp.OpenDoc6("C:\Irregular vessels\asm1.SLDASM", swDocASSEMBLY, swOpenDocOptions_Silent, "", errors, warnings) '啟動 asm1.SLDASM 檔
'...........................
Dim myDimension_19 As Object
Dim myDimension_5_1 As Object
Dim myDimension_5_2 As Object
Dim myDimension_5_3 As Object
Dim myDimension_5_4 As Object
Dim myDimension_5_5 As Object
Dim myDimension_5_6 As Object
Dim myDimension_5_7 As Object
Dim myDimension_5_8 As Object
Dim myDimension_5_9 As Object
Dim myDimension_5_10 As Object

scliang

Set myDimension_19 = Part.Parameter("D19@填料-伸長1@Part2^asm1.Part") '體積高
Set myDimension_5_1 = Part.Parameter("D1@草圖5@Part1.Part") '刻度高
Set myDimension_5_2 = Part.Parameter("D2@草圖5@Part1.Part")
Set myDimension_5_3 = Part.Parameter("D3@草圖5@Part1.Part")
Set myDimension_5_4 = Part.Parameter("D4@草圖5@Part1.Part")
Set myDimension_5_5 = Part.Parameter("D5@草圖5@Part1.Part")
Set myDimension_5_6 = Part.Parameter("D6@草圖5@Part1.Part")
Set myDimension_5_7 = Part.Parameter("D7@草圖5@Part1.Part")
Set myDimension_5_8 = Part.Parameter("D8@草圖5@Part1.Part")
Set myDimension_5_9 = Part.Parameter("D9@草圖5@Part1.Part")
Set myDimension_5_10 = Part.Parameter("D10@草圖5@Part1.Part")
'............................

scliang

With UserForm1
vt = .TextBox11.Value
sp = IIf(.OptionButton1.Value = True, 0.1, IIf(.OptionButton2.Value = True, 0.2, IIf(.OptionButton3.Value = True, 0.25, 0.5))) '刻度精度
volume_p = IIf(sp = 0.1, 1000, IIf(sp = 0.2, 2000, IIf(sp = 0.25, 2500, 5000)))
scale_1 = vt / 10 * 1000 '一刻度的容量
m = 0.8 '精度修正係數
k = 1
Debug.Print "刻度精度: " & sp
For i = 5 To 140 Step sp '以刻度精度之間隔循環取出體積
myDimension_19.SystemValue = i / 1000
boolstatus = Part.EditRebuild3()
Part.ClearSelection2 True
boolstatus = swModelDoc.Extension.SelectByID2("Part2^asm1-1@asm1", "COMPONENT", 0, 0, 0, False, 0, Nothing, swSelectOptionDefault)
Set comp = swModelDoc.SelectionManager.GetSelectedObject6(1, 0)
compbody = comp.GetBodies3(swAllBodies, bodyInfo)
Set swMass = swModelDoc.Extension.CreateMassProperty
boolstatus = swMass.AddBodies((compbody))
swMass.UseSystemUnits = False

scliang

val = Int(swMass.Volume) '當時體積'cc計算
If k = 11 Then Exit For
If val > vt * 1000 Then '超出總容量
MsgBox "超出刻度規格,請重新鍵入刻度規格值!"
Exit Sub
End If

If val < k * scale_1 + (volume_p * m) And val > k * scale_1 - (volume_p * m) Then
s(k) = i / 1000
k = k + 1
'Debug.Print "Mass - " & val
Debug.Print "Volume " & k - 1 & " - " & val '即時運算窗顯示容量值

End If

Next

'.....寫入 TextBox (mm)
.TextBox1.Value = Format(s(1) * 1000, "###0.00")
.TextBox2.Value = Format(s(2) * 1000, "###0.00")
.TextBox3.Value = Format(s(3) * 1000, "###0.00")
.TextBox4.Value = Format(s(4) * 1000, "###0.00")
.TextBox5.Value = Format(s(5) * 1000, "###0.00")
.TextBox6.Value = Format(s(6) * 1000, "###0.00")
.TextBox7.Value = Format(s(7) * 1000, "###0.00")
.TextBox8.Value = Format(s(8) * 1000, "###0.00")
.TextBox9.Value = Format(s(9) * 1000, "###0.00")
.TextBox10.Value = Format(s(10) * 1000, "###0.00")

scliang

'.....修改符合的刻度尺寸
myDimension_5_1.SystemValue = s(1)
myDimension_5_2.SystemValue = s(2)
myDimension_5_3.SystemValue = s(3)
myDimension_5_4.SystemValue = s(4)
myDimension_5_5.SystemValue = s(5)
myDimension_5_6.SystemValue = s(6)
myDimension_5_7.SystemValue = s(7)
myDimension_5_8.SystemValue = s(8)
myDimension_5_9.SystemValue = s(9)
myDimension_5_10.SystemValue = s(10)

boolstatus = Part.EditRebuild3()
Part.ClearSelection2 True

End With
End Sub

'~~~ 主程式 ~~~
Public Sub main()
UserForm1.Show
End Sub

scliang

Private Sub CommandButton1_Click()

TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
TextBox8.Value = ""
TextBox9.Value = ""
TextBox10.Value = ""

run
End Sub

Private Sub CommandButton2_Click()
End
End Sub

scliang

容量顯示:
如圖1,點選VBA 視窗上面功能列的 ”檢視" => “即時運算視窗.

圖1(即時運算視窗的體積單位是 mm^3)


Irregular vessels.zip (677.58 KB, 下載次數: 166)

2014/8/10 14:42 上傳

點擊文件名下載附件

2012

回憶楓

感謝分享