不規則容器刻度標示_宏 24#教程

ryouss · 发表于 2014-8-4 18:57:27

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

本帖最后由 ryouss 于 2014-8-8 11:12 编辑

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

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

tianlifang88 · 发表于 2014-8-4 19:52:12

这个不错原档能下不

tangcarlos3d · 发表于 2014-8-4 20:22:15

定积分的应用内容。

ryouss · 发表于 2014-8-5 09:46:10

改變容器大小,刻度隨著改變!

1239309629 · 发表于 2014-8-5 10:56:44

赞，超赞，相当的好

tianlifang88 · 发表于 2014-8-5 19:40:28

建议上传原档案

NC@jiang@nan · 发表于 2014-8-5 20:25:52

这都是神一般的存在呀。
膜拜。我只会简单的工作应用，稍深一点的就需要学习了。

machine134 · 发表于 2014-8-5 21:10:40

很棒，很想学习这个怎么做的

有彩虹的时光 · 发表于 2014-8-6 08:52:18

太牛了，顶一个。

ln0108 · 发表于 2014-8-6 08:55:04

梁大的宏用法真是牛赞

阿帕奇 · 发表于 2014-8-6 08:57:24

不断地再深挖啊

hbwalter · 发表于 2014-8-6 22:19:15

没有原档就不好了

ryouss · 发表于 2014-8-6 22:51:30

本帖最后由 ryouss 于 2014-8-6 23:04 编辑

hbwalter 发表于 2014-8-6 22:19 static/image/common/back.gif) N! \7 G& ~! `' z
没有原档就不好了

現在起算三天內20位支持者釋出作法...

andy1414 · 发表于 2014-8-7 08:15:43

也算我一個趕快推上去

FYWHB · 发表于 2014-8-7 08:27:33

也算我一個

kmjun88 · 发表于 2014-8-7 09:39:54

不错，用那个软件？

ryouss · 发表于 2014-8-7 09:42:05

kmjun88 发表于 2014-8-7 09:39 static/image/common/back.gif
6 a6 L) i- l, F1 U不错，用那个软件？

solidworks 2012 + vba +api

hanpingsiping · 发表于 2014-8-7 14:58:27

hero522 · 发表于 2014-8-7 15:03:42

頂出ryouss大的教程來

judyyai · 发表于 2014-8-7 15:07:37

頂一個~judy也想知道~

hawkerlin · 发表于 2014-8-8 09:14:10

强烈要求出教程哈，呵呵~坐等

guozhijie · 发表于 2014-8-8 09:17:12

太牛了，顶一个。

caption_cn · 发表于 2014-8-8 10:41:10

这个真心NB
我这几天想搞一个工程图另存PDF，名称按属性连接的小玩意儿都没搞定

ryouss · 发表于 2014-8-8 11:05:56

本帖最后由 ryouss 于 2014-8-8 11:39 编辑

謝謝諸位大大的支持!

不規則容器刻度宏的作法

前言:
要作不規則容器的刻度,最難的是不容易算出容量的體積,但在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)
即時視窗.png

編程

' 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

Irregular vessels.zip (677.58 KB, 下载次数: 23)

ryouss · 发表于 2014-8-8 11:28:19

本帖最后由 ryouss 于 2014-8-8 22:46 编辑

鼓勵支持本主題貼帖
1. 作出本主題如1#方式貼出圖者,前10位獎勵三維幣10點
2. 把本繁版編程轉成簡版且能證實執行有效者1位,獎勵三維幣30點
3. 以上獎勵截止日為8月13日24:00時.

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

通知

[分享] 不規則容器刻度標示_宏 24#教程

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

评分

点评

点评

点评

点评

点评

点评

点评

浏览过的版块