标题栏自动填写重量及比例的VBA代码及设置

fuzhan

以下方法在IP9及AIP11中通过，大伙有兴趣时可试试在其它版本能不能应用，你不能相信此代码的可靠性就请不要试了，谁看出那里出现问题请跟贴改正，多谢。
一、先设置零件模板
1、新建一个零件文档，在零件特性对话框中选择自定义面板，在名称处填写quality，类型为文本，值不用填写，然后按添加，得到一个自定义特性项，应用后关闭。

 

2、打开菜单栏：工具——宏——VB编辑器。

3、将左边工程-文档项目浏览器中的文档项目展开，双击Thisdocument，右边将会出现VB代码区，将下面的代码复制到里面。
Sub fu1()
f1 = Me.ComponentDefinition.MassProperties.Mass
f1 = Format(f1, "0.###")
If Right(f1, 1) = "." Then
f1 = Left(f1, (Len(f1) - 1))
End If
If f1 = 0 Then
f1 = ""
End If
End Sub

Sub fu2()
f2 = Me.ComponentDefinition.MassProperties.Mass
f2 = Format(f2, "0.###")
If Right(f2, 1) = "." Then
f2 = Left(f2, (Len(f2) - 1))
End If
If f2 = 0 Then
f2 = ""
End If
If f2 = f1 Then
Exit Sub
End If
fu3
End Sub

Sub fu3()
Dim f3, f4 As Integer
f3 = Me.PropertySets.Item(4).Count
For f4 = 1 To f3
If Me.PropertySets.Item(4).Item(f4).DisplayName = "quality" Then
Me.PropertySets.Item(4).Item(f4).Value = f2
End If
Next f4
End Sub

4、双击“模块1”，在右边出现的代码区复制以下代码进去：
Public f1, f2 As String
Public Sub Autosave()
Call ThisDocument.fu2
End Sub
Public Sub Autoopen()
Call ThisDocument.fu1
End Sub

5、关闭VB编辑器，关闭并保存零件文档，名字你喜欢，并将此零件文档复制到inventor的模板目录中，作模板用，完成第一步。

harderman

好好学习学习

fuzhan

二、设置工程图模板
1、新建一个工程图模板，当然里面要有你要定义的标题栏，打开工程图特性对话框，在自定义面板中新建一个名为fscale，类型为文本的特性项。

2、用刚才第一步建立的零件模板新建一个零件，在零件中随便画一个零件，并保存。

3、在要定义的工程图模板中插入上面的零件的基础视图。
4、定义标题栏，在要显示重量的地方设置：AIP9：自定义特性-模型，输入自定义的quality参数

                                                               AIP11：特性-模型，输入自定义的quality参数
          在要显示比例的地方设置：自定义特性-工程图，输入自定义的fscale参数
保存标题栏。

5、这时可以删除刚才插入的基础视图，并关闭已建立的零件图。
6、再次打开VB编辑器，与上次一样，在“Thisdocument”代码区复制入下面的代码：
Sub fu1()
If Me.Sheets.Count >= 1 Then
  If Me.Sheets.Item(1).DrawingViews.Count >= 1 Then
  f1 = Me.ActiveSheet.DrawingViews.Item(1).Scale
      End If
End If
End Sub

Sub fu2()
If Me.Sheets.Count >= 1 Then
  If Me.Sheets.Item(1).DrawingViews.Count >= 1 Then
  f4 = Me.ActiveSheet.DrawingViews.Item(1).Scale
    If f4 = f1 Then
    Exit Sub
  Else
    fu3
  End If
  Else
  f2 = ""
  End If
Else
f2 = ""
End If
fu4
End Sub

Sub fu3()
If f4 >= 1 Then
  f2 = f4 & ":" & 1
  Else
  Dim f3 As String
  f3 = 1 / f4
  If Len(f3) > 3 Then
  f2 = "0" & f4 & ":" & 1
  Else
  f2 = 1 & ":" & f3
  End If
End If
f1 = f4
End Sub

Sub fu4()
Dim f5, f6 As Integer
f5 = Me.PropertySets.Item(4).Count
For f6 = 1 To f5
If Me.PropertySets.Item(4).Item(f6).DisplayName = "fscale" Then
Me.PropertySets.Item(4).Item(f6).Value = f2
End If
Next f6
End Sub

7、在“模块1”的代码区插入以下代码：
Public f1, f4 As Double
Public f2 As String
Public Sub Autosave()
Call ThisDocument.fu2
End Sub
Public Sub Autoopen()
Call ThisDocument.fu1
End Sub

8、关闭VB编辑器，保存工程图，再将它复制到Tmplatem目录中，完成模板的创建。

在使用带有VBA的工程图模板时，可能会出现下图，展开选项，选择不要再显示此信息即可。
有兴趣的可试试，用不用是你的自由，在使用过程中按保存就可更新数据。

fuzhan

重量小于0.0009kg将视为0，即重量为空值，kg单位自己在标题栏处写好即可。
2006-6-29改写提取重量的代码，已重新编辑。

2006-6-30改正设置步聚上的错误

2006-6-30改写重量代码

2006-7-1在原来的代码基础上改写到更加简短，但没有更新论坛的内容。

qsir

改天试试．正是用得著的功能．

cxn

谢谢,下来学习学习.

suxil

非常好！谢谢你的分享！

lingling

好好学习学习

chzs

楼主能不能写个安装手册供下载？？多谢了

ghosthu

用这个方法能在标题栏中自动填写数量吗？

amani2521

这个是得研究研究。

谢谢楼主分享雷厄。