Just in case..here is how the routine looks now.
' Author: Wellington Gomes - Darby Anderson
Option Explicit
Sub CreateRunAutoNamedView()
ThisDrawing.SendCommand ("(defun C:RunAutoNamedView () (setvar ""filedia"" 0) (command ""_VBARUN"" ""CreateNamedViews"") (setvar ""filedia"" 1) )" & vbCr)
End Sub
Sub CreateNamedViews()
Dim mspace As AcadModelSpace
Dim mviews As AcadViews
Dim elem As Variant
Dim elemBl As Variant
Dim Incview As AcadView
Dim iIndex As Integer
Dim sName As String
Const XValue1 = 15.5 ' associated constant to XScale
Const YValue1 = 9.8125 ' associated constant to YScale
Const XValue2 = 11 ' associated constant to XScale
Const YValue2 = 8.5 ' associated constant to YScale
Const XValue3 = 8.5 ' associated constant to XScale
Const YValue3 = 11 ' associated constant to YScale
Dim X As Double, Y As Double
Dim point1 As Variant
Dim point2(0 To 1) As Double
'On Error Resume Next
Set mspace = ThisDrawing.ModelSpace
Set mviews = ThisDrawing.Views
For Each elem In mviews
elem.Delete
Next
iIndex = 0
For Each elemBl In mspace
If Not elemBl.EntityName = "AcDbBlockReference" Then GoTo Skip
Select Case elemBl.Name
Case "DWGATTRIBUTES", "dwgattributes", "DWGATTRIBUTES2"
X = XValue1: Y = YValue1
Case "IITITLEHA"
X = XValue2: Y = YValue2
Case "IITITLEVA"
X = XValue3: Y = YValue3
End Select
point1 = elemBl.InsertionPoint
point2(0) = elemBl.XScaleFactor * X + point1(0)
point2(1) = elemBl.YScaleFactor * Y + point1(1)
iIndex = 1 ' = nGetAttributes(elemBl) 'Get attribute TagString = PG
If Err.Number <> 0 Then
MsgBox "Error - Block without PG: " & elemBl.Name
Exit Sub
End If
If iIndex = 0 Then
MsgBox "Error - Block without PG: " & elemBl.Name
Exit Sub
End If
Set Incview = ThisDrawing.Views.Add(iIndex)
If Err.Number <> 0 Then
MsgBox "Error - Block already exists: " & iIndex
Exit For
End If
Incview.Width = elemBl.XScaleFactor * X
Incview.Height = elemBl.YScaleFactor * Y
point2(0) = Incview.Width / 2 + point1(0)
point2(1) = Incview.Height / 2 + point1(1)
Incview.Center = point2
Skip:
Next elemBl
End Sub
Function nGetAttributes(element) As Integer
Dim ArrayAttributes As Variant
Dim I As Integer, Num
ArrayAttributes = element.GetAttributes
For I = LBound(ArrayAttributes) To UBound(ArrayAttributes)
Select Case ArrayAttributes(I).TagString
Case "PG", "PG1", "2", "PAGE_NO."
Num = ArrayAttributes(I).TextString
If IsNumeric(Num) Then
nGetAttributes = Int(Num)
End If
Exit Function
End Select
Next
End Function