from AutoCAD XYZ coords to Screen coords

I'd like to write “on screen†the position number (a sort of ID number) of some elements of a drawing; my app reads the Xdata of each element and retrieves that number, writing it ON each element (they are 3Dsolids, so it will be written on the .Centroid point). How to transform the XYZ coordinates of AutoCAD in a certain view into the screen coordinates needed by the TextOut api call?

I’m thinking I ought to set the ucs parallel to the screen (in AutoCAD: UCS/New/view); then to TranslateCoordinates of each element from WCS to this UCS; finally to get the screen coordinates from a proportion between the WCS XY coords and the dimension of the current View, maybe using the ClientToScreen too, I’m not sure

Can anybody confirm or suggest a better way to transform the XYZ coords of Autocad in a certain view, into the XY screen coords?

 

I'm familiar with the TextOut api, so I have no idea what that does.

Having said that, there is/was also a Display Coordinate System within Acad.
I don't think I had ever used it, but maybe that's what you're looking for.

 

What are you expecting to do with the TextOut API function
and the AutoCAD display window? Have you actually tried
to output text to the AutoCAD window using this?

 

Tony, thank you so much to answer
- - -
In my work I usually draw wooden laminated structures; during the years, I have developed an app to draw these structures; my app is able to read the drawing and to output the bil of materials (each 3dsolid has his transformation matrix stored as xdata, so as the type of fastenings and some other information)
btw, there are many professional applications able to achieve this task, but I prefer my own tools

I have used a tree in a class module to order the elements (usually 150-200) according to height, width, length and some other criteria; of course it would be possible to make the app assign the ID number to each element (or group of identical elements), but I prefer to assign this ID "manually", picking the solid and entering the number (if I enter incidentally the same number in two different elements, the bill of materials will have 2, say, "pos.34", thanks to the fact that the tree is built by controlling ID number, then dimensions, volume and so on).

I'd like to show temporarily the assigned ID numbers; I have already used TextOut to show information, but in that case I used GetCursorPos to define where to write. Now I need to find the screen coordinates programmatically; the view is quite always isometric and always in model space

 

Are you saying that you have used TextOut to display
text on the AutoCAD drawing view window?

 

yes; it is a sort of "dist" command; what's wrong?
---
here the subs, just out of curiosity

Option Explicit

Private Const Output1 As String = "coords of pt1"
Private Const Output2 As String = "distances"
Private Const Output3 As String = "coords of pt1 and pt2 with distances"
Private Const Xfx As Single = 2.1
Private Const Yfx As Single = 2.1

Private Type XForm
eM11 As Single
eM12 As Single
eM21 As Single
eM22 As Single
eDx As Single
eDy As Single
End Type
Private Type POINTAPI
x As Long
y As Long
End Type

Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * 32
End Type

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Type Size
cx As Long
cy As Long
End Type

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

Private Declare Function SetTextAlign Lib "gdi32" (ByVal hdc As Long, ByVal wFlags As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As Size) As Long
Private Declare Function TextLen Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As Size) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long

' *********************** TRANSFORMATION MATRICES *********************** '
Private Declare Function SetWorldTransform Lib "gdi32" (ByVal hdc As Long, ByRef lpXform As XForm) As Long
Private Declare Function GetWorldTransform Lib "gdi32" (ByVal hdc As Long, ByRef lpXform As XForm) As Long
Private Declare Function SetGraphicsMode Lib "gdi32" (ByVal hdc As Long, ByVal iMode As Long) As Long
' *********************************************************************** '

Private Sub WriteOnScreen(str As Variant)
Const GM_ADVANCED As Long = &H2
Const TA_LEFT = 0
Const TA_RIGHT = 2
Const ANSI_CHARSET = 0
Const SYMBOL_CHARSET = 2
Const TRANSPARENT As Long = 1

Dim hdc As Long
Dim rct As RECT

Dim mx As XForm
Dim mxOld As XForm
Dim OldMode As Long

Dim FNT As LOGFONT
Dim FNTa As LOGFONT
Dim FNTSYM As LOGFONT
Dim hFont As Long
Dim hFontA As Long
Dim hFontSYM As Long
Dim hOldFont As Long

Dim PT As POINTAPI
Dim TxtBox As Size
Dim carX As Integer
Dim carY As Integer
Dim TxtBoxWidth As Integer ' *VAR USATA MA CHE PER ORA NON SERVE A NULLA*
Dim ST As String
Dim i As Integer

Err.Clear
On Error GoTo err0
hdc = GetWindowDC(ThisDrawing.hwnd)

With FNT
.lfHeight = 10
.lfWidth = 0 'default
.lfEscapement = 0
.lfOrientation = 0
.lfWeight = 600
.lfItalic = False
.lfUnderline = False
.lfStrikeOut = False
.lfCharSet = ANSI_CHARSET
.lfOutPrecision = 0 'Const OUT_DEFAULT_PRECIS = 0
.lfClipPrecision = 0 'Const CLIP_DEFAULT_PRECIS = 0
.lfQuality = 0 'Const DEFAULT_QUALITY = 0
.lfPitchAndFamily = 0 'Const DEFAULT_PITCH = 0
.lfFaceName = "Arial" & Chr(0)
End With
FNTa = FNT
FNTa.lfHeight = 6
FNTa.lfWeight = 600
FNTSYM = FNT
FNTSYM.lfCharSet = SYMBOL_CHARSET
FNTSYM.lfFaceName = "Symbol" & Chr(0)
FNTSYM.lfHeight = 10
Call SetBkMode(hdc, TRANSPARENT)
hFont = CreateFontIndirect(FNT)
hFontA = CreateFontIndirect(FNTa)
hFontSYM = CreateFontIndirect(FNTSYM)

'posizione del cursore con le coordinate relative a Thisdrawing
Call GetCursorPos(PT)
Call ScreenToClient(ThisDrawing.hwnd, PT)
Call GetWorldTransform(hdc, mxOld)
mx = mxOld
'sposta la matrice di trasformazione
With mx
.eDx = .eDx + PT.x '- IIf(PT.x >= ThisDrawing.Width / 2, 350, 0)
.eDy = .eDy + PT.y
.eM11 = .eM11 * Xfx
.eM22 = .eM22 * Yfx
End With

OldMode = SetGraphicsMode(hdc, GM_ADVANCED)
Call SetWorldTransform(hdc, mx)
SetTextColor hdc, vbGreen
SetTextAlign hdc, TA_RIGHT 'per le prime due righe

'inizio scrittura
'coord pts
If str(1, 5) = Output1 Or str(1, 5) = Output3 Then
TxtBoxWidth = 0
carX = 0
carY = 0
hOldFont = SelectObject(hdc, hFontA)
For i = 0 To 2
ST = IIf(i = 0, "", "___") & IIf(Len(str(0, i)) > Len(str(1, i)), str(0, i), str(1, i))
Call TextLen(hdc, ST, Len(ST), TxtBox)
carX = carX + TxtBox.cx
Call TextOut(hdc, carX, 0, str(0, i), Len(str(0, i)))
If str(1, 5) = Output3 Then Call TextOut(hdc, carX, TxtBox.cy, str(1, i), Len(str(1, i)))
Next
TxtBoxWidth = carX 'posizione estrema righe precedenti
End If
If str(1, 5) <> Output1 Then
carX = 0
carY = 13
'dist xy
Call SetTextAlign(hdc, TA_LEFT)
ST = Chr(114)
Call SelectObject(hdc, hFontSYM)
Call TextOut(hdc, carX, carY - 1, ST, Len(ST))
Call TextLen(hdc, ST, Len(ST), TxtBox)
carX = carX + TxtBox.cx
ST = "xy"
Call SelectObject(hdc, hFontA)
Call TextOut(hdc, carX, carY + 5, ST, Len(ST))
Call TextLen(hdc, ST, Len(ST), TxtBox)
carX = carX + TxtBox.cx
ST = "=" & str(1, 3) & " "
Call SelectObject(hdc, hFont)
Call TextOut(hdc, carX, carY, ST, Len(ST))
Call TextLen(hdc, ST, Len(ST), TxtBox)
'dist xyz
carX = carX + TxtBox.cx
ST = Chr(114)
Call SelectObject(hdc, hFontSYM)
Call TextOut(hdc, carX, carY - 1, ST, Len(ST))
Call TextLen(hdc, ST, Len(ST), TxtBox)
carX = carX + TxtBox.cx
ST = "xyz"
Call SelectObject(hdc, hFontA)
Call TextOut(hdc, carX, carY + 5, ST, Len(ST))
Call TextLen(hdc, ST, Len(ST), TxtBox)
carX = carX + TxtBox.cx
ST = "=" & str(1, 4) & " "
Call SelectObject(hdc, hFont)
Call TextOut(hdc, carX, carY, ST, Len(ST))
Call TextLen(hdc, ST, Len(ST), TxtBox)
'controla il massimo ingombro della terza riga:
carX = carX + TxtBox.cx
TxtBoxWidth = IIf(TxtBoxWidth < carX, carX, TxtBoxWidth)
'DELTA xx' yy' zz'
carX = 0
TxtBox.cx = 0
carY = 23
For i = 0 To 2
carX = carX + TxtBox.cx
ST = Chr(68)
Call SelectObject(hdc, hFontSYM)
Call TextOut(hdc, carX, carY, ST, Len(ST))
Call TextLen(hdc, ST, Len(ST), TxtBox)
carX = carX + TxtBox.cx
ST = Switch(i = 0, " x", i = 1, " y", i = 2, " z")
Call SelectObject(hdc, hFontA)
Call TextOut(hdc, carX, carY + 5, ST, Len(ST))
Call TextLen(hdc, ST, Len(ST), TxtBox)
carX = carX + TxtBox.cx
ST = "=" & str(0, 3 + i) & IIf(i < 2, " ", "")
Call SelectObject(hdc, hFont)
Call TextOut(hdc, carX, carY, ST, Len(ST))
Call TextLen(hdc, ST, Len(ST), TxtBox)
Next
'controla il massimo ingombro della quarta riga:
carX = carX + TxtBox.cx
TxtBoxWidth = IIf(TxtBoxWidth < carX, carX, TxtBoxWidth)
End If
' Debug.Print TxtBoxWidth


err0:
On Error Resume Next
Call SetWorldTransform(hdc, mxOld)
Call SetGraphicsMode(hdc, OldMode)
Call SelectObject(hdc, hOldFont)
Call DeleteObject(hFont)
Call DeleteObject(hFontA)
Call DeleteObject(hFontSYM)
Call ReleaseDC(ThisDrawing.hwnd, hdc)
End Sub

Sub GetPtsINFO()
Dim k As Integer
Dim i As Integer
Dim pt0 As Variant
Dim pt1 As Variant
Dim str(0 To 1, 0 To 5) As String


k = ThisDrawing.GetVariable("LUPREC")
Err.Clear
On Error Resume Next
pt0 = ThisDrawing.Utility.GetPoint
If Err.Number <> 0 Then Exit Sub
str(1, 5) = Output1
For i = 0 To 2
str(0, i) = Format(pt0(i), "0." & String(k, "0"))
Next
Err.Clear
pt1 = ThisDrawing.Utility.GetPoint(ThisDrawing.Utility.TranslateCoordinates(pt0, acWorld, acUCS, False))
If Err.Number = 0 Then
For i = 0 To 2
str(1, i) = Format(pt1(i), "0." & String(k, "0"))
Next
pt1(0) = pt1(0) - pt0(0): pt1(1) = pt1(1) - pt0(1): pt1(2) = pt1(2) - pt0(2)
For i = 0 To 2
str(0, 3 + i) = Format(pt1(i), "0." & String(k, "0")) 'DELTA xx' yy' zz'
Next
str(1, 3) = Format(Sqr(pt1(0) ^ 2 + pt1(1) ^ 2), _
"0." & String(k, "0")) 'dist_xy
str(1, 4) = Format(Sqr(pt1(0) ^ 2 + pt1(1) ^ 2 + pt1(2) ^ 2), _
"0." & String(k, "0")) 'dist_xyz
Err.Clear
On Error Resume Next
pt0 = ThisDrawing.Utility.GetPoint
If Err.Number <> 0 Then
str(1, 5) = Output2
Else
str(1, 5) = Output3
End If
End If
Call WriteOnScreen(str)
End Sub

 

Should have read "NOT familiar".

 

I've never needed to do something like that but I these system variables
will help: SCREENSIZE, VIEWSIZE, VIEWCTR

This is from AutoCad's help

setq SS (getvar "SCREENSIZE"); screen size in pixels
VS (getvar "VIEWSIZE") ; screen height in drawing units
SWP (car SS) ; width of screen in pixels
SHP (cadr SS) ; height of screen in pixels
AR (/ SWP SHP) ; aspect ratio width/height
WSD (* VS AR) ; width of screen dwg units = ratio times
height
PPDU (/ WSD SWP) ; pixels per drawing unit

 

Very impressive, but what happens if the user
pans or zooms (make the assumption that you
have no way of knowing they did)?

 

Thank you; I have asked that question to microsoft.public.vb.winapi some time ago; Mike D Sutton answered :

 

thanks to Tony Tanzillo and Jorge Jimenez for answering; I did it (anyway I'm still wondering whether there are better ways); given a WCS point "pt", the screen coords are :

Dim oldUCS As AcadUCS
Dim sz As Variant
Dim p0 As Variant
Dim h As Double
Dim w As Double
Dim pxl As Double
Dim ScrPt as PointAPI

On Error GoTo err0
With ThisDrawing
Set oldUCS = .ActiveUCS
.SendCommand "UCS New View UCS New X 180" & vbCr
p0 = .GetVariable("VIEWCTR")
sz = .GetVariable("SCREENSIZE")
h = .GetVariable("VIEWSIZE")
w = h * sz(0) / sz(1)
pxl = sz(1) / h
End With

pt = ThisDrawing.Utility.TranslateCoordinates(pt, acWorld, acUCS, False)
ScrPt.x = CLng((pt(0) - p0(0) + w / 2) * pxl)
ScrPt.y = CLng((pt(1) - p0(1) + h / 2) * pxl)

err0:
On Error Resume Next
ThisDrawing.ActiveUCS = oldUCS
Set oldUCS = Nothing

 

I apologize the NG; there is a big error in what I wrote; I didn't take the height of the TitleBar of Thisdrawing into account; the following line is right:

ScrPt.y = CLng((pt(1) - p0(1) + h / 2) * pxl + HeightOfTheTitleBar)

----
I retrieved the height with:

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Const CCHILDREN_TITLEBAR = 5

Private Type TITLEBARINFO
cbSize As Long
rcTitleBar As RECT
rgstate(CCHILDREN_TITLEBAR) As Long
End Type

Declare Function GetTitleBarInfo Lib "user32.dll" (ByVal hwnd As Long, ByRef pti As TITLEBARINFO) As Long

…

Dim TitleInfo As TITLEBARINFO

TitleInfo.cbSize = Len(TitleInfo)
GetTitleBarInfo ThisDrawing.hwnd, TitleInfo
HeightOfTheTitleBar= TitleInfo.rcTitleBar.Bottom - TitleInfo.rcTitleBar.Top

 

Very good.!
Thanks for keeping us updated