PDA

View Full Version : Type Mismatch



MZerby
2005-02-03, 05:22 PM
I'm getting an error in code that works on my computer but when I try loading it on our users computer they get a type mismatch error. In the PickTag Sub below they get a Type Mismatch error and when I debug it it highlights this line of code (.GetEntity objEnt, varPick, vbCrLf & "Pick a Window Tag: ") It runs fine in the Tempered Sub that I also listed below. Would anyone have any insite into my problem?

Thank You in advance,
Mike Z.


Sub PickTag()
Dim varPick As Variant
Dim objEnt As AcadEntity
Dim objBref As AcadBlockReference
Dim objAttrib As AcadAttributeReference
Dim varAttribs As Variant
Dim intI As Integer
Dim Model As String
Dim FLength As String
Dim insertionPoint As Variant
Dim textObj As AcadMText
Dim textString As String
Dim height As Double


On Error Resume Next
With ThisDrawing.Utility

.GetEntity objEnt, varPick, vbCrLf & "Pick a Window Tag: "
If Err Then Exit Sub

Set objBref = objEnt

varAttribs = objBref.GetAttributes



For intI = LBound(varAttribs) To UBound(varAttribs)
Set objAttrib = varAttribs(intI)

If objAttrib.TagString = "MODEL" Then

Model = objAttrib.textString
FLength = Len(Model) * 1.375
insertionPoint = objBref.insertionPoint

If objAttrib.Rotation <> 0 Then
insertionPoint(0) = insertionPoint(0) - 3
insertionPoint(1) = insertionPoint(1) + FLength + 3.75

Set textObj = ThisDrawing.ModelSpace.AddMText(insertionPoint, 22, "(EGRESS)")

textObj.height = 4.5
textObj.StyleName = "format1"
textObj.Layer = "Model No"
textObj.Rotation = 1.5707963267949
textObj.Update
Exit Sub

Else
insertionPoint(0) = insertionPoint(0) + FLength + 3.75
insertionPoint(1) = insertionPoint(1) + 3

Set textObj = ThisDrawing.ModelSpace.AddMText(insertionPoint, 22, "(EGRESS)")

textObj.height = 4.5
textObj.StyleName = "format1"
textObj.Layer = "Model No"
textObj.Rotation = 0
textObj.Update

End If


End If

Next

End With
End Sub




Public Sub Tempered()
Dim varPick As Variant
Dim objEnt As AcadEntity
Dim objBref As AcadBlockReference
Dim objAttrib As AcadAttributeReference
Dim varAttribs As Variant
Dim strAttribs As String
Dim intI As Integer
Dim Model As String
Dim Desc As String


On Error Resume Next
With ThisDrawing.Utility

.GetEntity objEnt, varPick, vbCrLf & "Pick a Window Tag: "
If Err Then Exit Sub

Set objBref = objEnt

varAttribs = objBref.GetAttributes

For intI = LBound(varAttribs) To UBound(varAttribs)
Set objAttrib = varAttribs(intI)

If objAttrib.TagString = "MODEL" Then
Model = objAttrib.textString
objAttrib.textString = Model & "T"
End If

If objAttrib.TagString = "DESCRIPTION" Then
Desc = objAttrib.textString
objAttrib.textString = Desc & " " & "(TEMPERED)"
End If

Next

End With

End Sub

mtuersley
2005-02-04, 05:07 AM
If its not in your code, make sure you specify Option Explicit and then see what happens. GetEntity is not a vba command so it needs to be prefaced with the library that it comes from - ThisDrawing.Utility.

Also, try removing the On Error Resume Next - that is worse than no error handling at all since it will disguise the true source of an error.

MZerby
2005-02-04, 12:35 PM
Thank you for the help! I tried what you suggested and it's working now. I tested that on about 4 network computers before I released it to all the users. Just proves to me that Murphy is still alive and well.

Thanks again,
Mike

P.S. I'll remember your advice on the one error resume next statement.