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

fuzhan 发表于 2006-6-28 20:27:00

本帖最后由作者于 2006-6-30 14:01:59 编辑 以下方法在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 发表于 2023-10-8 15:24:58

好好学习学习

fuzhan 发表于 2006-6-28 20:33:00

本帖最后由作者于 2006-6-30 8:44:34 编辑 二、设置工程图模板 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 发表于 2006-6-29 10:29:00

本帖最后由作者于 2006-7-3 10:42:25 编辑 重量小于0.0009kg将视为0，即重量为空值，kg单位自己在标题栏处写好即可。 2006-6-29改写提取重量的代码，已重新编辑。
2006-6-30改正设置步聚上的错误
2006-6-30改写重量代码
2006-7-1在原来的代码基础上改写到更加简短，但没有更新论坛的内容。

qsir 发表于 2006-6-29 20:20:00

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

cxn 发表于 2006-6-29 20:29:00

谢谢,下来学习学习.

suxil 发表于 2006-6-29 20:30:00

非常好！谢谢你的分享！

lingling 发表于 2006-7-1 11:26:00

好好学习学习

chzs 发表于 2006-7-2 07:13:00

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

ghosthu 发表于 2006-7-5 11:32:00

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

amani2521 发表于 2006-7-8 14:50:00

这个是得研究研究。
谢谢楼主分享雷厄。

页: [1] 2 3

明经CAD社区's Archiver

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