iCAx开思网

标题: 不規則容器刻度標示_宏 6#教程 [打印本页]

作者: ryouss 时间: 2014-8-4 17:39
标题: 不規則容器刻度標示_宏 6#教程
本帖最后由 ryouss 于 2014-8-8 14:14 编辑

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

[attach]1204264[/attach]

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

该贴已经同步到 ryouss的微博

作者: gt.adan 时间: 2014-8-5 12:02
頂起！期待討論！更期待梁叔的分享~~

作者: gt.adan 时间: 2014-8-5 12:06
壇子裡 2005 年就見討論，當時SW的限制還是很多吧？
但是悶大還是做出來了~足見軟件是死的人腦是活的~
相當有趣的練習，期待大家的參入討論~
附上當年的連結：https://www.icax.org/thread-179206-2-17.html

作者: ryouss 时间: 2014-8-5 14:06

gt.adan 发表于 2014-8-5 12:06
壇子裡 2005 年就見討論，當時SW的限制還是很多吧？
但是悶大還是做出來了~足見軟件是死的人腦是活的~
相 ...

謝謝單版主的關注.
另草圖的解決,大致是如下圖所示吧!

註解是體積(mm^3)

[attach]1204322[/attach]

作者: mzqzr 时间: 2014-8-5 19:48
精彩。。。

作者: ryouss 时间: 2014-8-8 13:57
本帖最后由 ryouss 于 2014-8-8 15:00 编辑

作參考

不規則容器刻度宏的作法

前言:
要作不規則容器的刻度,最難的是不容易算出容量的體積,但在sw提供了    只要能做出一個體積從物質特性就能查得,所以就想用宏應該能解決,這肯定就要牽涉到sw 的 API ,個人對VBA 是比較熟練(常用在EXCEL),對API是非常陌生,雖然API說明資料很豐富,問題是根本不知道用什麼”關鍵詞”去查找,還好發了不少時間總算找到如”資料1”,在組件(裝配體)取出一些物質特性的API編程,這才解決了完成本主題的作業,結論就是只要”用心執著地做一件事,總是會有所得的”,就算是找不到所要的,最少在查找的過程中,還是會吸收到其他知識.

計算方法:
用宏解決取出體積,但如何處理體積和刻度的關係尺寸,就想從杯底到容量體積拉高時逐步取適當變量,如0.5mm,1,1.5…用VBA做循環計算到刻度所需的體積值就能夠相互對應了,這計算方式暫且就叫做”試誤法”,這之間就有個誤差精度問題,所以取了四個等級0.1,0.2,0.25,0.5,等級值越低容量誤差越小,當然計算循環也就越費時間.
容量顯示:
如圖1,點選VBA 視窗上面功能列的 ”檢視" => “即時運算視窗.
宏簡繁版注意事項:
本版是繁體版,要在簡體版執行宏時,編程里的繁體字要改為簡體字,
但有 ' 符號字母後頭的文字可以不改,在VBA里只是文字補述而以,
編程里的繁體字改為簡體字後,也要注意對應草圖的名稱也要修改.
操作說明:
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.

資料1:  在SW API說明找到的資料

This example show how to get the mass of the selected component of an assembly.

'---------------------------------------------
'
' Preconditions:
' 1. Specified assembly document exists.
' 2. Open the Immediate window.
' 3. Run the macro.
'
' Postconditions: Mass of the selected component printed to
' Immediate window.
'

'---------------------------------------------
Option Explicit
Sub main()
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 boolstatus As Boolean
Dim errors As Long
Dim warnings As Long
Set swApp = Application.SldWorks
Set swModelDoc = swApp.OpenDoc6("C:\program files\solidworks corp\solidworks\samples\tutorial\edraw\claw\claw-mechanism.sldasm", swDocASSEMBLY, swOpenDocOptions_Silent, "", errors, warnings)
boolstatus = swModelDoc.Extension.SelectByID2("collar-1@claw-mechanism", "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
val = swMass.mass
Debug.Print "Mass - " & val
val = swMass.Volume
Debug.Print "Volume - " & val
val = swMass.Density
Debug.Print "Density - " & val
val = swMass.SurfaceArea
Debug.Print "Surface area - " & val
params = swMass.CenterOfMass
Debug.Print "Center of mass - X: " & params(0) & " ,Y: " & params(1) & ", and Z: " & params(2)
End Sub

圖1(即時運算視窗的體積單位是 mm^3)
[attach]1204645[/attach]

編程
[attach]1204643[/attach]
'  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.
'
'---------------------------------------------

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
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")
'............................
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
'val = swMass.Mass '質量
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")

'.....修改符合的刻度尺寸
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

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

[attach]1204644[/attach]2012

作者: ryouss 时间: 2014-8-8 13:58
另個問題討論一下
如圖為何外觀稍為拉大一些就會出錯,
有何方式作圖可以改善?

[attach]1204646[/attach]

作者: gt.adan 时间: 2014-8-8 16:53
頂起梁叔~希望引來更多喜好宏的同好們一起討論！

作者: mrdior 时间: 2014-8-13 08:17
路过，太厉害了

作者: rock_on 时间: 2014-10-15 08:29
太厉害了

作者: keybao 时间: 2016-4-26 17:12
非常历害

作者: zsega 时间: 2016-5-1 10:58
學習學習，感謝

作者: makejon 时间: 2018-10-5 09:49
都是niub人才

作者: a8012024 时间: 2018-10-8 06:42
谢谢分享！

欢迎光临 iCAx开思网 (https://www.icax.org/)