addtitleblock with one prompted entry

[Anonymous]

Hi,
I have a titleblock in a drawing but i want to delete it and replace it with an another one
which have a prompted entry (scale). But i can't find the way to do this.
Lucas Edited by: kalupower on Aug 19, 2009 2:46 PM

[Anonymous]

See attached image.

We used to do Prompted Entry for scale but now we programmatically apply (VB.NET 2008 Express [freeware] addin) so there is no need to prompt. Instead we create a custom file property (SCALE) and the the addin populate the custom file property. See code below. I use the OnTerminateCommand event to sense when a base view is created or edited (i.e. perhaps the scale of the base view has changed) and use the OnChange event to sense when a view is deleted (i.e. if a view is delete perhaps there is no scale or a different view becomes the new base view). If you need help implementing this, I could give you a hand.

{code}
Private Sub moUserInputEvents_OnTerminateCommand(ByVal CommandName As String, ByVal Context As Inventor.NameValueMap) Handles moUserInputEvents.OnTerminateCommand

If CommandName = "DrawingViewEditCtxCmd" Or CommandName = "DrawingBaseViewCmd" Then
UpdateDrawingScaleAndPartNumber()
End If
End Sub


Private Sub moDocumentEvents_OnChange( _
ByVal ReasonsForChange As Inventor.CommandTypesEnum, _
ByVal BeforeOrAfter As Inventor.EventTimingEnum, _
ByVal Context As Inventor.NameValueMap, _
ByRef HandlingCode As Inventor.HandlingCodeEnum) Handles moDocumentEvents.OnChange

If BeforeOrAfter = EventTimingEnum.kAfter Then
Dim i As Integer = 0
Dim sContextName As String = ""
Dim oContextValue As Object = Nothing
Dim iConsideredDirty As Integer = -1
Dim sDisplayName As String = ""
Dim sInternalName As String = ""
Dim s1stInternalNamesListItem As String = ""

'First gather information
If Not Context Is Nothing Then
If Context.Count > 0 Then
For i = 1 To Context.Count
Dim contextValue As Object = Context.Item(i)

If TypeOf contextValue Is Array Then
'reportString = reportString & vbCrLf & " " & Context.Name(i)

Dim tempArray As Array
tempArray = CType(Context.Item(i), Array)

s1stInternalNamesListItem = tempArray(0)
Else
sContextName = Context.Name(i)
oContextValue = ValueOf(contextValue, sContextName)
If sContextName = "ConsideredDirty" Then
iConsideredDirty = oContextValue
ElseIf sContextName = "DisplayName" Then
sDisplayName = sStripOffEndQuotes(oContextValue)
ElseIf sContextName = "InternalName" Then
sInternalName = sStripOffEndQuotes(oContextValue)
End If
End If
Next
End If 'Context.Count > 0
End If 'Not Context Is Nothing

If s1stInternalNamesListItem = "DeleteViews" Then
'Reevaluate which is the base view so drawing scale and part number
'are always correct. Although drawing part number isn't really
'important(because) it doesn't show up anywhere like drawing BOM
'or our title blocks.
'
'ReasonsForChange: kReferencesChangeCmdType, kShapeEditCmdType
'Context:
' ConsideredDirty = 1 2
' DisplayName = "Delete Selections" 2
' InternalName = "CompositeChange" 2
' InternalNamesList()
' "DeleteViews" 1
' "DeleteViewsPostProcess" 1
' "DeleteEmblemPostProcess" 1
'BeforeOrAfter: kAfter()
' HandlingCode: Unknown type specified.

UpdateDrawingScaleAndPartNumber()

End If 's1stInternalNamesListItem = "DeleteViews"
End If 'BeforeOrAfter = EventTimingEnum.kAfter
End Sub


Private Sub UpdateDrawingScaleAndPartNumber()
On Error GoTo Hell

Dim oDrawingDocument As DrawingDocument
Dim oSheet As Sheet
Dim oTitleBlock As TitleBlock = Nothing
Dim sTitleBlockName As String
Dim oTitleBlockDefinition As TitleBlockDefinition
Dim oDrawingSketch As DrawingSketch
Dim oTextBox As TextBox
Dim oTextBoxScale As TextBox = Nothing
Dim dScale As Double
Dim sScale As String = ""
Dim vParts As Object
Dim bRecalc As Boolean
Dim oDrawingViewBase As DrawingView = Nothing
Dim oScaleProperty As Inventor.Property = Nothing

'Must be a drawing because the command is a drawing command.
oDrawingDocument = goInvApp.ActiveDocument

oSheet = oDrawingDocument.ActiveSheet

If Not oSheet.TitleBlock Is Nothing Then
sTitleBlockName = oSheet.TitleBlock.Name
oTitleBlockDefinition = oDrawingDocument.TitleBlockDefinitions.Item( _
sTitleBlockName)
oDrawingSketch = oTitleBlockDefinition.Sketch
'Set oTextBox = oDrawingSketch.TextBoxes.Item("Scale") 'Doesn't work
For Each oTextBox In oDrawingSketch.TextBoxes
'Debug.Print oTextBox.FormattedText
'If oTextBox.Text = "Scale" Then
If oTextBox.Text = "" Then
oTextBoxScale = oTextBox
Exit For
End If
Next
End If

If Not oTextBoxScale Is Nothing Then

'Since the part number comes from the 1st view in the drawing regardless of the
'viewing angle (ortho, iso, etc), the scale should come from that view as well
'oDrawingViewBase = oGet1stOrthoBaseViewIfNot1stBaseView(oSheet)
If oSheet.DrawingViews.Count > 0 Then
oDrawingViewBase = oSheet.DrawingViews.Item(1)
End If

If oDrawingViewBase Is Nothing Then
'oSheet.TitleBlock.SetPromptResultText(oTextBoxScale, "")
'Summary Information, {F29F85E0-4FF9-1068-AB91-08002B27B3D9}
'Document Summary Information, {D5CDD502-2E9C-101B-9397-08002B2CF9AE}
'Design Tracking Properties, {32853F0F-3444-11D1-9E93-0060B03C1CA6}
'User Defined Properties, {D5CDD505-2E9C-101B-9397-08002B2CF9AE}
On Error Resume Next
oScaleProperty = oDrawingDocument.PropertySets( _
"{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("SCALE")
On Error GoTo Hell
If oScaleProperty Is Nothing Then
oScaleProperty = oDrawingDocument.PropertySets( _
"{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add("", "SCALE")
Else
oScaleProperty.Value = ""
End If
oDrawingDocument.Update2(True)
Else
'Obtain Scale Prompted Value TextBox (Note) so it's value can
'be potentially changed. "Potentially" meaning something besides
'scale could have changed but there's no way of knowing what since
'the Context (NameValueMap) argument is empty (i.e. Inventor
'programmers could have populated it to tell name what has changed).

If Not oTextBoxScale Is Nothing Then

'Determine if the the View's scale (potentially changed) matches the
'the Scale Prompted Value, if not then recalculate the scale from
'the View and display it in the Scale Prompted Value TextBox (Note)


'This would help to leave a scale unchanged if the scale has spaces
'and the scale equals the View's scale. I decided to leave this
'out because technically spaces don't belong in the scale
'sScale = Trim(oSheet.TitleBlock.GetResultText(oTextBoxScale))
'sScale = Replace(sScale, " ", "")

dScale = oDrawingViewBase.[Scale]
If InStr(sScale, ":") > 0 And InStr(sScale, ":") = _
InStrRev(sScale, ":") Then

vParts = Split(sScale, ":")
If IsNumeric(vParts(0)) And IsNumeric(vParts(1)) Then
If (CDbl(vParts(0)) / CDbl(vParts(1))) <> dScale Then
bRecalc = True
End If
Else
bRecalc = True
End If
Else
bRecalc = True
End If

'Recalculate the scale from the View and display it in the Scale
'Prompted Value TextBox (Note)

If bRecalc Then
If dScale = 0.75 Then
sScale = "3:4"
ElseIf dScale >= 1 Then
If dScale = Fix(dScale) Then
sScale = Fix(dScale) & ":1"
Else
dScale = Math.Round(dScale, 3)
sScale = dScale & ":1"
End If
Else
'Need the reciprical in order to display the scale in
'the(correct) format however odd scales like "4:3"
'will be displayed as "1.25:1"
dScale = 1 / dScale
If dScale = Fix(dScale) Then
sScale = "1:" & Fix(dScale)
Else
dScale = Math.Round(dScale, 3)
sScale = "1:" & dScale
End If
End If

'oSheet.TitleBlock.SetPromptResultText(oTextBoxScale, sScale)
On Error Resume Next
oScaleProperty = oDrawingDocument.PropertySets( _
"{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("SCALE")
On Error GoTo Hell
If oScaleProperty Is Nothing Then
oScaleProperty = oDrawingDocument.PropertySets( _
"{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add( _
sScale, "SCALE")
Else
oScaleProperty.Value = sScale
End If
oDrawingDocument.Update2(True)

LogUsage("RecalculateDrawingScale", "M:\Usage.log", _
True, 1, "20", "Recalculate drawing scale to update " & _
"the Prompted Text Note in the title block")
End If

End If 'Not oTextBoxScale Is Nothing

'Upon creation of the first base view, Inventor populates the
'drawing's "Part Number" iProperty with the "Part Number" iProperty
'from the model. This ensures the drawing's "Part Number" iProperty
'is alway accurate because if all the views are deleted then a new
'base view is created, this will update said iProp.
'
'Also update the drawing's "Part Number" iProperty
'{32853F0F-3444-11D1-9E93-0060B03C1CA6} = "Design Tracking Properties"
oDrawingDocument.PropertySets("{32853F0F-3444-11D1-9E93-0060B03C1CA6}"). _
Item("Part Number").Value = oDrawingViewBase.ReferencedDocumentDescriptor. _
ReferencedDocument.PropertySets("{32853F0F-3444-11D1-9E93-0060B03C1CA6}"). _
Item("Part Number").Value

End If 'Not oDrawingViewBase Is Nothing
End If 'Not oTextBoxScale Is Nothing
Exit Sub

Hell:
MsgBox("UpdateDrawingScaleAndPartNumber: " & Err.Description)
End Sub
{code}

[Anonymous]

Thank you

Lucas