How to determine model space area defined by a paper space viewport

[Anonymous]

I have an interesting problem.  I have thousands of drawings I am processing.  Some of our engineering companies improperly put annotation and dimensions into model space on scaled drawings.  They reuse the contents of large amounts of drawing content in model space across hundreds of separate drawings in paper space.  I am needing to do tag extraction on these drawings.  BUT, I only want to extract the tags that appear on each drawing, not ALL the tags that are hidden in model space.  So, to give an example, in the model space of a typical drawing would contain hundreds of tags, while the viewable tags through the viewports in paper space where the titlelbock is would be 10. 

I have been looking at different ways of identifying the exact area of a paperspace viewport in model space, but none of them will work.  The CHSPACE command would work if I did each drawing manually as I would create a box around the viewport, then push the graphics to the model space using the CHSPACE command.  This of course won't work because you have to manually select the graphics, then manually select the viewport.  This of course won't work while processing thousands of drawings.

The second option I have seen was to zoom to centre of the viewports, then get the height and width of the viewports, get the scale factor of the viewport and determine the coordinates in model space.  This would be an ideal solution, but for some reason it is not consistent. 

I was wondering if there is anyone out there that has needed to mass process drawings to do the same kind of task that could help.

Thanks

[maratovich]

It can be done.
Attach the sample file.
And an example that should be.
It is necessary to check for your case.

[Anonymous]

I have attached a good example.  There are like 6 viewports in paperspace and a HUGE amount of graphics and tags in model space that I do not want to extract.  Only the tags that are viewable through the paperspace viewports.

Thanks

[maratovich]

I did not quite understand - what exactly do you call the tag?
In what form should it be obtained?

[norman.yuan]

Since you post in VBA forum, I assume you can write VBA code to some degree and need to know the process of doing this thing (if you don't, then this may be a quite development project you need to find someone to do for you), take processing one drawing as an example:

1. on each paperspace layout with viewports, find each viewport;

2. For each viewport, find its 4 corners' coordinates

3. Translate each corner's coordinate into ModelSpace coordinate (look at AcadUtility.TranslateCoordinates()

4. Use the obtained points in ModelSpace to select all the entities in the window enclosed by the points

5. Loop through these entities to identify entities in interest ("tag" in your description), and do whatever is needed.

If the viewport is twiested, or have irregular boundary, things would be a bit more complicated, but the logic remains the same. Actually, you have mentioned the most part of it, and if you do it correctly, the result should be consistent (when you say "but for some reason it is not consistent", the "some reason" is probably you did not do it correctly. Show some code if you have).

[Anonymous]

Here is the code.  I have a extra code where I am looking for tags within the coordinates specificied by the viewport coordinates after being transformed into modelspace.  It works for one viewport, then it doesn't work for the rest.

Dim acUtil As AcadUtility

 Dim acVport As AcadViewport

 Dim acSS As AcadSelectionSet

 Dim acVp As AcadObject

 Dim sLayout As String

 Dim iCode() As Integer

 Dim vValue() As Variant

 Dim vPt As Variant

 Dim vPtMs As Variant

 Dim dHt As Double

 Dim dWd As Double

 Dim dScl As Double

 Dim dUR(2) As Double

 Dim dLL(2) As Double

 Dim vBlnInfo As Variant

Set acUtil = ThisDrawing.Utility

 ZoomExtents 'must have to show complete viewports

 For Each acVp In ThisDrawing.PaperSpace

    If acVp.ObjectName = "AcDbViewport" Then

    vPt = acVp.Center

    dWd = acVp.Width / 2 'set to half width

    dHt = acVp.Height / 2 'set to half height

    dScl = 1 / acVp.CustomScale 'inverse of scale factor

    ThisDrawing.MSpace = True 'needed to translate coordinates

    vPtMs = acUtil.TranslateCoordinates(vPt, acPaperSpaceDCS, acDisplayDCS, 0)

    vPtMs = acUtil.TranslateCoordinates(vPtMs, acDisplayDCS, acWorld, 0)

   'Now we have the center in modelspace

    dLL(0) = vPtMs(0) - (dWd * dScl): dLL(1) = vPtMs(1) - (dHt * dScl)

   dUR(0) = vPtMs(0) + (dWd * dScl): dUR(1) = vPtMs(1) + (dHt * dScl)

Dim Dline As AcadLine

‘ I just draw a diagonal line in modelspace to represent where the viewport should be. It works on first one, then doesn’t work on any other viewport.  I usually have at least 6 viewports in a drawing

Set Dline = ThisDrawing.ModelSpace.AddLine(dLL, dUR)

'After this is where I search for all acdbtext and acdbmtext and block attributes to gather tags, and making sure their insertion points are between dLL and dUR

ThisDrawing.MSpace = False

ZoomExtents

End If

Next acVp

Thanks for your help!!!

[maratovich]

Your file has no blocks. Unable to get tag.
In the example, a lot of texts. Which one is needed?
Show us the final result.

[Anonymous]

I already have the code to pull out the tags.  I gather all the text strings that are mtext, text or attributes blocks and send to my tag parser.  That is not the issue here.  The issue I am having is being able to identify the area in model space that the paper space viewport is looking at.  If you look at the model space, you will see so much content that I do NOT want to extract the tags.  Only what is shown in the viewports on paperspace.  I have attached an image of a sample of the data from one of the viewports that I am trying to extract.

Again, my issue is not extracting the text strings as that is easy.  Also, once I have the coordinates of the paperspace view into modelspace, pulling the text strings based on knowing those coordinates is also easy.  Is it just figuring out HOW to identify those coordinates of each viewport is my issue.

Thanks again!

[Anonymous]

sorry, forgot the image

[maratovich · Accepted solution]

See an example for finding blocks. This is done for other purposes, but the principle is the same.
You can get the coordinates in the space model.

Public Sub SubVieportObrabotka(APViewport As Object, ByVal Allblock As Boolean)
On Error Resume Next
'-------------------+
Dim i As Long
Dim Width As Double
Dim Height As Double
Dim Min, Max As Variant
Dim VpMin(0 To 2) As Double
Dim VpMax(0 To 2) As Double
Dim CoordModelMin(0 To 2) As Double
Dim CoordModelMax(0 To 2) As Double
Dim CoordViewMin(0 To 2) As Double
Dim CoordViewMax(0 To 2) As Double
Dim VpScale As Double
Dim Sdvig As Double
Dim EstBlocki As Boolean
Dim VPcenter As Variant
Dim PVport 'As AcadPViewport
Dim varViewCtr As Variant
Dim TochkaVstavkiStrelka As Variant
Dim TochkaVstavkiS As Boolean
Dim TochkaVstavkiVinoska As Variant
Dim TochkaVstavkiV As Boolean
Dim MSG As String
'----------------------------------------------------------------------------------+
ThisDrawing.MSpace = False
ThisDrawing.ActivePViewport = APViewport
Set PVport = APViewport
VPcenter = PVport.Center
Width = PVport.Width
Height = PVport.Height
VpScale = CDbl(PVport.CustomScale)
'----------------------------------------------------------------------------------+
'Получаем координаты куда смотрит вьюпорт
PVport.GetBoundingBox Min, Max
VpMin(0) = Min(0)
VpMin(1) = Min(1)
VpMin(2) = Min(2)
VpMax(0) = Max(0)
VpMax(1) = Max(1)
VpMax(2) = Max(2)
'----------------------------------------------------------------------------------+
PVport.DisplayLocked = True 'Заблокировать видовой экран
'----------------------------------------------------------------------------------+
PVport.Display True ' активируем видовой экран
ThisDrawing.MSpace = True
ThisDrawing.ActivePViewport = APViewport 'это надо чтоб выбор вьюпорта сработал
'----------------------------------------------------------------------------------+
'Проверяем и устанавливаем ПСК по виду
ThisDrawing.SendCommand ("_UCS" & vbCr & "_view" & vbCr)
'----------------------------------------------------------------------------------+
'Преобразуем чтобы потом вычислить
Min = ThisDrawing.Utility.TranslateCoordinates(Min, 3, 2, False)
Max = ThisDrawing.Utility.TranslateCoordinates(Max, 3, 2, False)
CoordModelMin(0) = Min(0)
CoordModelMin(1) = Min(1)
CoordModelMin(2) = Min(2)
CoordModelMax(0) = Max(0)
CoordModelMax(1) = Max(1)
CoordModelMax(2) = Max(2)
'----------------------------------------------------------------------------------+
'Получаем центр того что показывает вьюпорт
varViewCtr = ThisDrawing.GetVariable("VIEWCTR") ' это именно раньше чем переход в модель
'----------------------------------------------------------------------------------+
'Расчитываем координаты окна выбора для поиска блоков
CoordViewMin(0) = varViewCtr(0) - (Width / 2) / VpScale 'Min(0)
CoordViewMin(1) = varViewCtr(1) - (Height / 2) / VpScale 'Min(0)
CoordViewMin(2) = Min(2)
CoordViewMax(0) = varViewCtr(0) + (Width / 2) / VpScale ''Max(0)
CoordViewMax(1) = varViewCtr(1) + (Height / 2) / VpScale ''Max(1)
CoordViewMax(2) = Max(2)
'----------------------------------------------------------------------------------+
ReDim ParamBlock(10000) 'предварительно зарезервируем массив
EstBlocki = False
'EstBlocki = SubGetBlocks(CoordModelMin, CoordModelMax)
EstBlocki = SubGetBlocks(CoordViewMin, CoordViewMax, Allblock)
'----------------------------------------------------------------------------------+
ThisDrawing.MSpace = False
'----------------------------------------------------------------------------------+
PVport.DisplayLocked = False  'Разблокировать видовой экран
'----------------------------------------------------------------------------------+
If EstBlocki = False Then
   MsgBox "Not Blocks !"
   Povtor = False
   Exit Sub
End If
'----------------------------------------------------------------------------------+
'----------------------------------------------------------------------------------+
'----------------------------------------------------------------------------------+
'----------------------------------------------------------------------------------+
'Показать всё после
If OknoVLeader.Check_Zoom.Value = 1 Then
   ThisDrawing.Application.ZoomExtents
End If
'----------------------------------------------------------------------------------+
If OknoVLeader.Check_Regen.Value = 1 Then
   ThisDrawing.Regen 1
End If
'----------------------------------------------------------------------------------+
If Allblock = True Then
   MsgBox "OK"
End If
End Sub

[maratovich]

[Anonymous]

This code worked for what I needed.  I didn't really want to use SendCommands, but I don't think there is any way around those? 

Thanks for all your help! 

[maratovich]

Try to remove this string.  (SendCommands)
The code was created to work in 3D.
You 2D, maybe it is not required.