PaperSpace и SelectSet

Option Explicit
Sub test()
Dim oSset As AcadSelectionSet
Dim oEnt As AcadEntity
Dim blkRef As AcadBlockReference
Dim dxfcode(0 To 1) As Integer
Dim dxfdata(0 To 1) As Variant
dxfcode(0) = 0
dxfdata(0) = "INSERT"
dxfcode(1) = 2
dxfdata(1) = InputBox(vbCr & vbCr & "Enter block name:", "Block Name")
Dim setName As String, i As Integer
Dim hgt As Double, scl As Double
hgt = ThisDrawing.GetVariable("DIMTXT")
hgt = hgt * 0.0001
setName = "$Blocks$"
'Make sure selection set does not exist
For i = 0 To ThisDrawing.SelectionSets.Count - 1
If ThisDrawing.SelectionSets.Item(i).Name = setName Then
ThisDrawing.SelectionSets.Item(i).Delete
Exit For
End If
Next i
' select all blocks
Set oSset = ThisDrawing.SelectionSets.Add(setName)
oSset.Select acSelectionSetAll, , , dxfcode, dxfdata
ThisDrawing.Utility.Prompt "Selected: " & oSset.Count & " blocks"
'Process each block instance
For Each oEnt In oSset
Dim iD As Long
iD = oEnt.OwnerID
Dim oLayObj As AcadObject
Set oLayObj = ThisDrawing.ObjectIdToObject(iD)
If oLayObj.Name Like "*Paper*" Then
Dim oLayout As AcadBlock
Set oLayout = oLayObj
Set blkRef = oEnt
Dim pt As Variant
pt = blkRef.InsertionPoint
Dim oText As AcadText
Set oText = oLayout.AddText("Test String", pt, hgt)
End If
Next
oSset.Delete
Set oSset = Nothing
End Sub

(defun _kpblc-conv-point-from-layout-to-model (vp pt / res)
                                              ;|
*    Преобразование координат точки из пространства листа в пространство модели
*    Параметры вызова:
*    vp    ename-указатель на ВЭ
*    pt    координаты точки
|;
  (_kpblc-error-catch
    (function
      (lambda ()
        (setq res (mapcar '-
                          (cdr (assoc 12 (entget vp)))
                          (mapcar '(lambda (x)
                                     (/ x
                                        (/ (cdr (assoc 41 (entget vp)))
                                           (cdr (assoc 45 (entget vp)))
                                           ) ;_ end of /
                                        ) ;_ end of /
                                     ) ;_ end of lambda
                                  (mapcar '- (cdr (assoc 10 (entget vp))) pt)
                                  ) ;_ end of mapcar
                          ) ;_ end of mapcar
              ) ;_ end of setq
        ) ;_ end of lambda
      ) ;_ end of function
    '(lambda (x)
       (princ (strcat "_kpblc-conv-point-from-layout-to-model ERROR : " x))
       ) ;_ end of lambda
    ) ;_ end of _kpblc-error-catch
  ) ;_ end of defun

(defun _kpblc-error-catch (protected-function
                           on-error-function
                           /
                           catch_error_result
                           )
                          ;|
*** Функция взята из книжной версии ruCAD'a без каких бы то ни было переделок,
*** кроме переименования.
*    Оболочка отлова ошибок.
*    Параметры вызова:
*    protected-function    - "защищаемая" функция
*    on-error-function    - функция, выполняемая в случае ошибки
|;
  (setq catch_error_result (vl-catch-all-apply protected-function))
  (if (and (vl-catch-all-error-p catch_error_result)
           on-error-function
           ) ;_ end of and
    (apply on-error-function
           (list (vl-catch-all-error-message catch_error_result))
           ) ;_ end of apply
    catch_error_result
    ) ;_ end of if
  ) ;_ end of defun

Public Sub VPAdjust(VP As AcadPViewport, Tg As Variant)
 Dim Min, Max As Variant
 VP.GetBoundingBox Min, Max
 oldMode = ThisDrawing.MSpace
 ThisDrawing.MSpace = True
 Min = ThisDrawing.Utility.TranslateCoordinates(Min, acPaperSpaceDCS, acDisplayDCS, False)
 Tg(0) = Tg(0) - Min(0)
 Tg(1) = Tg(1) - Min(1)
 VP.Target = Tg
 ThisDrawing.MSpace = oldMode
End Sub
Public Sub VPCoords(VP As AcadPViewport, ll, ur)
'Calculates the extents of a PaperSpace viewport in ModelSpace units
'Arguments: An AcadPViewport entity and two variants.
' The variants will be filled with the corner points.
 Dim Min, Max, oldMode As Boolean
 VP.GetBoundingBox Min, Max
 oldMode = ThisDrawing.MSpace
 ThisDrawing.MSpace = True
 ll = ThisDrawing.Utility.TranslateCoordinates(Min, acPaperSpaceDCS, acDisplayDCS, False)
 ur = ThisDrawing.Utility.TranslateCoordinates(Max, acPaperSpaceDCS, acDisplayDCS, False)
 ThisDrawing.MSpace = oldMode
End Sub