Produkt: AutoCAD 2002/2004
Datum: 20.05.2003
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
llCornerAs
VariantDim
urCornerAs
VariantSub
GetViewExtents()Dim
pdHeightAs
DoubleDim
pdWidthAs
DoubleDim
pvCtrAs
VariantDim
pvScreenSizeAs
VariantDim
pdMin(2)As
DoubleDim
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