Vấn đề Zoom trong VBA

[NguyenNgocSon 43]

Các bạn trong diễn đàn cho mình hỏi phương thức zom đối tượng bằng VBA ? (Zoom Object)

Cám ơn !

[phantuhuong 217]

Có phương thức ZoomAll, ZoomCenter, ZoomExtents, ZoomWindow... Bạn xem đoạn code sau nhé:

 

 

Sub Example_ZoomWindow() ' This example creates several objects in model space and ' then performs a variety of zooms on the drawing. 
' Create a Ray object in model space 
Dim rayObj As AcadRay Dim basePoint(0 To 2) As Double 
Dim SecondPoint(0 To 2) As Double 
basePoint(0) = 3#: basePoint(1) = 3#: basePoint(2) = 0# SecondPoint(0) = 1#: SecondPoint(1) = 3#: SecondPoint(2) = 0# 
Set rayObj = ThisDrawing.ModelSpace.AddRay(basePoint, SecondPoint)
 ' Create a polyline object in model space 
Dim plineObj As AcadLWPolyline 
Dim points(0 To 5) As Double points(0) = 3: points(1) = 7 points(2) = 9: points(3) = 2 points(4) = 3: points(5) = 5 
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points) plineObj.Closed = True 
' Create a line object in model space Dim lineObj As AcadLine 
Dim startPoint(0 To 2) As Double 
Dim endPoint(0 To 2) As Double startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0 endPoint(0) = 2: endPoint(1) = 2: endPoint(2) = 0 
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
 ' Create a circle object in model space 
Dim circObj As AcadCircle Dim centerPt(0 To 2) As Double Dim radius As Double centerPt(0) = 20: centerPt(1) = 30: centerPt(2) = 0 radius = 3 
Set circObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius) 
' Create an ellipse object in model space 
Dim ellObj As AcadEllipse 
Dim majAxis(0 To 2) As Double 
Dim center(0 To 2) As Double 
Dim radRatio As Double center(0) = 5#: center(1) = 5#: center(2) = 0# majAxis(0) = 10: majAxis(1) = 20#: majAxis(2) = 0# radRatio = 0.3 
Set ellObj = ThisDrawing.ModelSpace.AddEllipse(center, majAxis, radRatio)
' ZoomAll
MsgBox "Perform a ZoomAll", , "ZoomWindow Example"
ZoomAll

' ZoomWindow
MsgBox "Perform a ZoomWindow using the following coordinates:" & vbCrLf & _
"1.3, 7.8, 0" & vbCrLf & _
"13.7, -2.6, 0", , "ZoomWindow Example"

Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
point1(0) = 1.3: point1(1) = 7.8: point1(2) = 0
point2(0) = 13.7: point2(1) = -2.6: point2(2) = 0
ZoomWindow point1, point2

' ZoomScaled
MsgBox "Perform a ZoomScaled using:" & vbCrLf & _
"Scale Type: acZoomScaledRelative" & vbCrLf & _
"Scale Factor: 2", , "ZoomWindow Example"
Dim scalefactor As Double
Dim scaletype As Integer
scalefactor = 2
scaletype = acZoomScaledRelative
ZoomScaled scalefactor, scaletype

' ZoomExtents
MsgBox "Perform a ZoomExtents", , "ZoomWindow Example"
ZoomExtents

' ZoomPickWindow
MsgBox "Perform a ZoomPickWindow", , "ZoomWindow Example"
ZoomPickWindow

' ZoomCenter
MsgBox "Perform a ZoomCenter using:" & vbCrLf & _
"Center 3, 3, 0" & vbCrLf & _
"Magnification: 10", , "ZoomWindow Example"
Dim zcenter(0 To 2) As Double
Dim magnification As Double
zcenter(0) = 3: zcenter(1) = 3: zcenter(2) = 0
magnification = 10
zoomcenter zcenter, magnification

End Sub