Produkt: AutoCAD 2002/2004
Datum: 20.05.2003
Stáhnout VBA projekt (5 KByte)
V některých uživatelských aplikacích AutoCADu může být potřeba pracovat s rozsahem souřadnic zobrazovaných v právě aktuálním okně (např. modelového prostoru). Následující funkce slouží právě ke zjištění souřadnic levého dolního a pravého horního rohu okna výkresu.
Pro přenesení VBA kódu funkce si pomocí Alt-F11 spusťte editor VBA a zkopírujte si tento jednoduchý kód (nebo si otevřete přiložený projekt .DVB):
Dim llCorner As Variant
Dim urCorner As Variant
Sub GetViewExtents()
Dim pdHeight As Double
Dim pdWidth As Double
Dim pvCtr As Variant
Dim pvScreenSize As Variant
Dim pdMin(2) As Double
Dim pdMax(2) As Double
'Center Point of the View
pvCtr = ThisDrawing.GetVariable("VIEWCTR")
pvCtr = ThisDrawing.Utility.TranslateCoordinates(pvCtr, acUCS, acDisplayDCS, 0)
'Screen resolution
pvScreenSize = ThisDrawing.GetVariable("SCREENSIZE")
'Screen Height
pdHeight = ThisDrawing.GetVariable("VIEWSIZE")
'Screen Width
pdWidth = pdHeight * (pvScreenSize(0) / pvScreenSize(1))
'lower left
pdMin(0) = pvCtr(0) - (pdWidth / 2)
pdMin(1) = pvCtr(1) - (pdHeight / 2)
'upper right
pdMax(0) = pvCtr(0) + (pdWidth / 2)
pdMax(1) = pvCtr(1) + (pdHeight / 2)
'Set LL and UR window corner
llCorner = ThisDrawing.Utility.TranslateCoordinates(pdMin, acDisplayDCS, acWorld, 0)
urCorner = ThisDrawing.Utility.TranslateCoordinates(pdMax, acDisplayDCS, acWorld, 0)
'Draw an informative Line
'ThisDrawing.ModelSpace.AddLine llCorner, urCorner
End Sub
Rutinu GetViewExtents nyní můžete použít pro zjištění rozsahu okna (v globálních souřadnicích). Oba rohové body budou naplněny do proměnných llCorner a urCorner (typu Variant). Odkomentováním posledního řádku si můžete nechat nakreslit informativní úsečku přes diagonálu okna.
Copyright © 2003 CAD Studio