新手请教关于自动测量装配体外围尺寸宏问题

sw的宏第一次用 找了些资料学习了下，想弄个自动测外观尺寸的宏，刚好有人分享了个。可是运行没反应，不知道是我操作问题还是什么问题，我新建了个粘贴进去运行出现问题代码 黄色的部分，各位大神有知道怎么回事的吗指教下 我是来学习的，代码进制上传？各位多多指教哈

看看能不能上传下代码文件'*********************************************************************'This macro gets the bounding box dimensions for the config specific
'* model and adds a small amount to it.  This amount can be changed
'* by modifying the "AddFactor" value below.  It checks to make sure
'* you have a proper document open.  It checks & utilizes the user units.
'* It will add 3 separate properties or combine them all into one property.
'* It will optionally draw a 3D sketch for you.
'*
'* Modified by Wayne Tiffany, Oct 12, 2004
'* Updated 10/15/04
'*
'* Original few lines of demo code by someone else (unknown).  Fraction
'* converter original code from rocheey.  3D sketch original code from
'* SW help.
'*
'* Modified by Gneful, Jun 27, 2005
'* Support Chinese-Simplified Language.
'*
'* Modified by Francis, 2005-7-18
'* Through the STL format to get the tightest box

'* Modified by Pyczt, 2007-1-30
'* Add dimension in 3D sketch
'*********************************************************************

Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim Height As Variant
Dim Width As Variant
Dim Length As Variant
Dim Corners As Variant
Dim retval As Boolean
Dim UserUnits As Variant
Dim ConvFactor As Double
Dim AddFactor As Double
Dim ConfigName  As String
Dim SwConfig As SldWorks.Configuration
Dim MsgResponse As Integer
Dim swSketchPt(8) As SldWorks.SketchPoint
Dim swSketchSeg(12) As SldWorks.SketchSegment

Public lang As String

Function DecimalToFeetInches(DecimalLength As Variant, Denominator As Integer) As String
  ' converts decimal inches to feet/inches/fractions

  Dim intFeet As Integer
  Dim intInches As Integer
  Dim intFractions As Integer
  Dim FractToDecimal As Double
  Dim remainder As Double
  Dim tmpVal As Double

  ' compute whole feet
  intFeet = Int(DecimalLength / 12)
  remainder = DecimalLength - (intFeet * 12)
  tmpVal = CDbl(Denominator)

  ' compute whole inches
  intInches = Int(remainder)
  remainder = remainder - intInches

  ' compute fractional inches & check for division by zero
  If Not (remainder = 0) Then
    If Not (Denominator = 0) Then
      FractToDecimal = 1 / tmpVal
        If FractToDecimal > 0 Then
          intFractions = Int(remainder / FractToDecimal)
          If (remainder / FractToDecimal) - intFractions > 0 Then  ' Round up so bounding box is always larger.
            intFractions = intFractions + 1
          End If
        End If
     End If
  End If
      'Debug.Print "Feet = " & intFeet & ", Inches = " & intInches & ", Numerator = " & intFractions & ", Denominator = " & FractToDecimal
  Call FractUp(intFeet, intInches, intFractions, Denominator) ' Simplify up & down

  ' format output
  DecimalToFeetInches = LTrim$(Str$(intFeet)) & "'-"
  DecimalToFeetInches = DecimalToFeetInches & LTrim$(Str$(intInches))
  If intFractions > 0 Then
    DecimalToFeetInches = DecimalToFeetInches & " "
    DecimalToFeetInches = DecimalToFeetInches & LTrim$(Str$(intFractions))
    DecimalToFeetInches = DecimalToFeetInches & "\" & LTrim$(Str$(Denominator))
  End If

  DecimalToFeetInches = DecimalToFeetInches & Chr$(34)
      'Debug.Print DecimalToFeetInches

End Function

Function FractUp(InputFt As Integer, InputInch As Integer, InputNum As Integer, InputDenom As Integer)

       'Debug.Print InputFt, InputInch, InputNum, InputDenom

  ' Simplify the fractions, Example: 6/8" becomes 3/4"
  While InputNum Mod 2 = 0 And InputDenom Mod 2 = 0
    InputNum = InputNum / 2
    InputDenom = InputDenom / 2
  Wend

  ' See if we now have a full inch or 12 inches.  If so, bump stuff up
  If InputDenom = 1 Then  ' Full inch
    InputInch = InputInch + 1
    InputNum = 0
    If InputInch = 12 Then  ' Full foot
      InputFt = InputFt + 1
      InputInch = 0
    End If
  End If
       'Debug.Print InputFt, InputInch, InputNum, InputDenom

End Function

Function GetCurrentConfigName()

  Set SwConfig = Part.GetActiveConfiguration  ' See what config we are now on & set the variable
  GetCurrentConfigName = Part.GetActiveConfiguration.Name  ' Return the name

End Function

Sub Main()

  AddFactor = 0 ' This is the amount added - change to suit

  Set swApp = CreateObject("SldWorks.Application")
  lang = swApp.GetCurrentLanguage
  setLangStr
  Set Part = swApp.ActiveDoc

  If Part Is Nothing Then                    ' Did we get anything?
    MsgBox sNoOpendFile, vbCritical
    Exit Sub
  End If

httmp = Environ("tmp") & "\"

  If Part.GetType = swDocPart Or Part.GetType = swDocASSEMBLY Then  ' Units will come back as meters

  'backup STL options
        STLBinaryFormat = swApp.GetUserPreferenceToggle(swSTLBinaryFormat)
        STLShowInfoOnSave = swApp.GetUserPreferenceToggle(swSTLShowInfoOnSave)
        STLDontTranslateToPositive = swApp.GetUserPreferenceToggle(swSTLDontTranslateToPositive)
        STLComponentsIntoOneFile = swApp.GetUserPreferenceToggle(swSTLComponentsIntoOneFile)
        STLCheckForInterference = swApp.GetUserPreferenceToggle(swSTLCheckForInterference)
        STLQuality = swApp.GetUserPreferenceIntegerValue(swSTLQuality)
        ImportStlVrmlModelType = swApp.GetUserPreferenceIntegerValue(swImportStlVrmlModelType)
        ImportStlVrmlUnits = swApp.GetUserPreferenceIntegerValue(swImportStlVrmlUnits)
        ExportStlUnits = swApp.GetUserPreferenceIntegerValue(swExportStlUnits)
        STLDeviation = swApp.GetUserPreferenceDoubleValue(swSTLDeviation)
        STLAngleTolerance = swApp.GetUserPreferenceDoubleValue(swSTLAngleTolerance)

  'set STL options for this action
        swApp.SetUserPreferenceToggle swSTLBinaryFormat, 1
        swApp.SetUserPreferenceToggle swSTLShowInfoOnSave, 0
        swApp.SetUserPreferenceToggle swSTLDontTranslateToPositive, 1
        swApp.SetUserPreferenceToggle swSTLComponentsIntoOneFile, 1
        swApp.SetUserPreferenceToggle swSTLCheckForInterference, 0
        swApp.SetUserPreferenceIntegerValue swSTLQuality, swSTLQuality_Custom
        swApp.SetUserPreferenceIntegerValue swImportStlVrmlModelType, 0  '0 = Graphics body
        swApp.SetUserPreferenceIntegerValue swImportStlVrmlUnits, swMM
        swApp.SetUserPreferenceIntegerValue swExportStlUnits, swMM
        swApp.SetUserPreferenceDoubleValue swSTLDeviation, 0.5 / 1000
        swApp.SetUserPreferenceDoubleValue swSTLAngleTolerance, 3.1415926 / 180 * 30

  'export & import the STL
        Part.SaveAs2 httmp & "$$$$$$$$.STL", 0, True, True
        swApp.LoadFile2 httmp & "$$$$$$$$.STL", "r"

  'restore the original STL options
        swApp.SetUserPreferenceToggle swSTLBinaryFormat, STLBinaryFormat
        swApp.SetUserPreferenceToggle swSTLShowInfoOnSave, STLShowInfoOnSave
        swApp.SetUserPreferenceToggle swSTLDontTranslateToPositive, STLDontTranslateToPositive
        swApp.SetUserPreferenceToggle swSTLComponentsIntoOneFile, STLComponentsIntoOneFile
        swApp.SetUserPreferenceToggle swSTLCheckForInterference, STLCheckForInterference
        swApp.SetUserPreferenceIntegerValue swSTLQuality, STLQuality
        swApp.SetUserPreferenceIntegerValue swImportStlVrmlModelType, ImportStlVrmlModelType
        swApp.SetUserPreferenceIntegerValue swImportStlVrmlUnits, ImportStlVrmlUnits
        swApp.SetUserPreferenceIntegerValue swExportStlUnits, ExportStlUnits
        swApp.SetUserPreferenceDoubleValue swSTLDeviation, STLDeviation
        swApp.SetUserPreferenceDoubleValue swSTLAngleTolerance, STLAngleTolerance

        Set cpart = swApp.ActiveDoc
        Corners = cpart.GetPartBox(True)         ' True comes back as system units - meters
        swApp.CloseDoc "$$$$$$$$"
        Kill httmp & "$$$$$$$$.STL"
  Else
    MsgBox sUnusefulFileType, vbCritical
    Exit Sub
  End If

  UserUnits = Part.GetUnits()
'    Debug.Print "LengthUnit = " & UserUnits(0)
'    Debug.Print "Fraction Base = " & UserUnits(1)
'    Debug.Print "FractionDenominator = " & UserUnits(2)
'    Debug.Print "SignificantDigits = " & UserUnits(3)
'    Debug.Print "RoundToFraction = " & UserUnits(4)

  Select Case Part.GetUnits(0)
    Case swMM
      ConvFactor = 1 * 1000
    Case swCM
      ConvFactor = 1 * 100
    Case swMETER
      ConvFactor = 1
    Case swINCHES
      ConvFactor = 1 / 0.0254
    Case swFEET
      ConvFactor = 1 / (0.0254 * 12)
    Case swFEETINCHES
      ConvFactor = 1 / 0.0254  ' Pass inches through
    Case swANGSTROM
      ConvFactor = 10000000000#
    Case swNANOMETER
      ConvFactor = 1000000000
    Case swMICRON
      ConvFactor = 1000000
    Case swMIL
      ConvFactor = (1 / 0.0254) * 1000
    Case swUIN
      ConvFactor = (1 / 0.0254) * 1000000
  End Select

  Height = Round((Abs(Corners(4) - Corners(1)) * ConvFactor) + AddFactor, UserUnits(3)) ' Z axis
  Width = Round((Abs(Corners(5) - Corners(2)) * ConvFactor) + AddFactor, UserUnits(3))  ' Y axis
  Length = Round((Abs(Corners(3) - Corners(0)) * ConvFactor) + AddFactor, UserUnits(3)) ' X axis

  If (UserUnits(0) = 5 Or UserUnits(0) = 3) And UserUnits(1) = 2 Then
    Height = DecimalToFeetInches(Height, Val(UserUnits(2)))
    Width = DecimalToFeetInches(Width, Val(UserUnits(2)))
    Length = DecimalToFeetInches(Length, Val(UserUnits(2)))
  End If

  MsgBoxMsg = "长宽高 = " & Height & " x " & Width & " x " & Length & vbCr & vbCr & sDrawBoundBox
  MsgResponse = MsgBox(MsgBoxMsg, vbInformation + vbYesNo)
  If MsgResponse = vbYes Then Call DrawBox


  ConfigName = GetCurrentConfigName() ' See what config we are now on

  MsgBoxMsg = sPropertyType

  MsgResponse = MsgBox(MsgBoxMsg, vbInformation + vbYesNoCancel)

  Select Case MsgResponse
    Case vbYes ' One property
      retval = Part.DeleteCustomInfo2(ConfigName, "长宽高") 'Remove existing properties
      retval = Part.AddCustomInfo3(ConfigName, "长宽高", swCustomInfoText, _
               Height & " x " & Width & " x " & Length)  'Add latest values
    Case vbNo ' 3 properties
      'Remove existing properties
      retval = Part.DeleteCustomInfo2(ConfigName, "Height")
      retval = Part.DeleteCustomInfo2(ConfigName, "Width")
      retval = Part.DeleteCustomInfo2(ConfigName, "Length")
      'Add latest values
      retval = Part.AddCustomInfo3(ConfigName, "Height", swCustomInfoNumber, Height)
      retval = Part.AddCustomInfo3(ConfigName, "Width", swCustomInfoNumber, Width)
      retval = Part.AddCustomInfo3(ConfigName, "Length", swCustomInfoNumber, Length)
  End Select

End Sub


Sub DrawBox()

  Part.Insert3DSketch2 True
  Part.SetAddToDB True
  Part.SetDisplayWhenAdded False

  'Draw points at each corner of bounding box
  Set swSketchPt(0) = Part.CreatePoint2(Corners(3), Corners(1), Corners(5))
  Set swSketchPt(1) = Part.CreatePoint2(Corners(0), Corners(1), Corners(5))
  Set swSketchPt(2) = Part.CreatePoint2(Corners(0), Corners(1), Corners(2))
  Set swSketchPt(3) = Part.CreatePoint2(Corners(3), Corners(1), Corners(2))
  Set swSketchPt(4) = Part.CreatePoint2(Corners(3), Corners(4), Corners(5))
  Set swSketchPt(5) = Part.CreatePoint2(Corners(0), Corners(4), Corners(5))
  Set swSketchPt(6) = Part.CreatePoint2(Corners(0), Corners(4), Corners(2))
  Set swSketchPt(7) = Part.CreatePoint2(Corners(3), Corners(4), Corners(2))

  ' Now draw bounding box
  Set swSketchSeg(0) = Part.CreateLine2(swSketchPt(0).X, swSketchPt(0).Y, swSketchPt(0).Z, swSketchPt(1).X, swSketchPt(1).Y, swSketchPt(1).Z)
  Set swSketchSeg(1) = Part.CreateLine2(swSketchPt(1).X, swSketchPt(1).Y, swSketchPt(1).Z, swSketchPt(2).X, swSketchPt(2).Y, swSketchPt(2).Z)
  Set swSketchSeg(2) = Part.CreateLine2(swSketchPt(2).X, swSketchPt(2).Y, swSketchPt(2).Z, swSketchPt(3).X, swSketchPt(3).Y, swSketchPt(3).Z)
  Set swSketchSeg(3) = Part.CreateLine2(swSketchPt(3).X, swSketchPt(3).Y, swSketchPt(3).Z, swSketchPt(0).X, swSketchPt(0).Y, swSketchPt(0).Z)
  Set swSketchSeg(4) = Part.CreateLine2(swSketchPt(0).X, swSketchPt(0).Y, swSketchPt(0).Z, swSketchPt(4).X, swSketchPt(4).Y, swSketchPt(4).Z)
  Set swSketchSeg(5) = Part.CreateLine2(swSketchPt(1).X, swSketchPt(1).Y, swSketchPt(1).Z, swSketchPt(5).X, swSketchPt(5).Y, swSketchPt(5).Z)
  Set swSketchSeg(6) = Part.CreateLine2(swSketchPt(2).X, swSketchPt(2).Y, swSketchPt(2).Z, swSketchPt(6).X, swSketchPt(6).Y, swSketchPt(6).Z)
  Set swSketchSeg(7) = Part.CreateLine2(swSketchPt(3).X, swSketchPt(3).Y, swSketchPt(3).Z, swSketchPt(7).X, swSketchPt(7).Y, swSketchPt(7).Z)
  Set swSketchSeg(8) = Part.CreateLine2(swSketchPt(4).X, swSketchPt(4).Y, swSketchPt(4).Z, swSketchPt(5).X, swSketchPt(5).Y, swSketchPt(5).Z)
  Set swSketchSeg(9) = Part.CreateLine2(swSketchPt(5).X, swSketchPt(5).Y, swSketchPt(5).Z, swSketchPt(6).X, swSketchPt(6).Y, swSketchPt(6).Z)
  Set swSketchSeg(10) = Part.CreateLine2(swSketchPt(6).X, swSketchPt(6).Y, swSketchPt(6).Z, swSketchPt(7).X, swSketchPt(7).Y, swSketchPt(7).Z)
  Set swSketchSeg(11) = Part.CreateLine2(swSketchPt(7).X, swSketchPt(7).Y, swSketchPt(7).Z, swSketchPt(4).X, swSketchPt(4).Y, swSketchPt(4).Z)

'Add dimension in 3D sketch
    Dim retval As Boolean
    retval = swApp.GetUserPreferenceToggle(swInputDimValOnCreate)
    swApp.SetUserPreferenceToggle swInputDimValOnCreate, False
    Dim Annotation As Object
    boolstatus = Part.Extension.SelectByID2("Line1", "SKETCHSEGMENT", 0, 0, 0, False, 0, Nothing, 0)
    Set Annotation = Part.AddDimension2(swSketchPt(0).X / 2 + swSketchPt(1).X / 2, swSketchPt(0).Y / 2 + swSketchPt(1).Y / 2, swSketchPt(0).Z / 2 + swSketchPt(0).Z / 2)
    boolstatus = Part.Extension.SelectByID2("Line2", "SKETCHSEGMENT", 0, 0, 0, False, 0, Nothing, 0)
    Set Annotation = Part.AddDimension2(swSketchPt(1).X / 2 + swSketchPt(2).X / 2, swSketchPt(1).Y / 2 + swSketchPt(2).Y / 2, swSketchPt(1).Z / 2 + swSketchPt(2).Z / 2)
    boolstatus = Part.Extension.SelectByID2("Line5", "SKETCHSEGMENT", 0, 0, 0, False, 0, Nothing, 0)
    Set Annotation = Part.AddDimension2(swSketchPt(0).X / 2 + swSketchPt(4).X / 2, swSketchPt(0).Y / 2 + swSketchPt(4).Y / 2, swSketchPt(0).Z / 2 + swSketchPt(4).Z / 2)
    swApp.SetUserPreferenceToggle swInputDimValOnCreate, retval

  Part.SetDisplayWhenAdded True
  Part.SetAddToDB False
  Part.Insert3DSketch2 True

End Sub

没有人哈，小弟笨拙，初次学习 请多指教

从三维网又下了个可以用，只是这个宏所创建的3d草图也不是很准 简单零件可以大概外围轮廓，（并不是相切） 大一点的装配体误差会很大 明显看的出来，有没有其他好的办法了精确一点的？：）