[求助]如何得到图纸空间视口四点的坐标

fjfhgdwfn

现在图纸空间有一个矩形视口，如何得到这四个角点在模型空间的坐标。

即如何根据模型空间的一个矩形，新建一个视口正好与这个矩形相重合。

看了下帮助，好像没有讲视口显示的模型空间的基点啊！

fjfhgdwfn

Public Sub VPCoords(vp As AcadPViewport, ll, ur)

    Dim min, max, oldMode As Boolean
   
    vp.GetBoundingBox min, max
    oldMode = ThisDrawing.MSpace
    ThisDrawing.MSpace = True
    ll = ThisDrawing.Utility.TranslateCoordinates(min, acPaperSpaceDCS, acDisplayDCS, False)
    ur = ThisDrawing.Utility.TranslateCoordinates(max, acPaperSpaceDCS, acDisplayDCS, False)
    ThisDrawing.MSpace = oldMode
   
End Sub
这个可以实现，不过要倒过来如何实现呢。就是知一个矩形及比例，如何生成一个大小相同的视口？

jiapeng2008

对啊，为什么没人回答。我也遇到这个问题。急啊。

fjfhgdwfn

我的问题解决了，在视口中，用zoomwindows，可以实现。

jiapeng2008

楼主：

    请明示吧。怎么用zoomwindows命令。我在开发文档里没有发现这个命令啊。用Vpcoords为什么我转成acWorld坐标里就不行了呢。没有输出。多谢。

fjfhgdwfn

Sub sk_jl() '根据两点及比较在图纸空间新建视口
    Dim returnObj As AcadObject
    Dim vv As AcadPViewport
   
    Dim basePnt1 As Variant
    Dim basePnt2 As Variant
    Dim leftlow(0 To 2) As Double
    Dim righttow(0 To 2)  As Double
    Dim bl As Double
    Dim kd As Double
    Dim gd As Double
    Dim jd As Double
   
    UserForm3.Show
    gd = 250
    bl = UserForm3.TextBox1.Value '比例
    
    Dim returnPnt As Variant
     'On Error Resume Next
     ThisDrawing.ActiveSpace = acModelSpace
    
    basePnt1 = ThisDrawing.Utility.GetPoint(, "Enter a point: ")
    basePnt2 = ThisDrawing.Utility.GetPoint(, "Enter a  Next point: ")
   
    jd = fwj(basePnt2(0) - basePnt1(0), basePnt2(1) - basePnt1(1)) '计算角度
    kd = ((basePnt2(0) - basePnt1(0)) ^ 2 + (basePnt2(1) - basePnt1(1)) ^ 2) ^ 0.5 * bl

    leftlow(0) = basePnt1(0) + gd / 2 * bl * Cos(jd - 3.1415926 / 2)
    leftlow(1) = basePnt1(1) + gd / 2 * bl * Sin(jd - 3.1415926 / 2)
    righttow(0) = basePnt2(0) + gd / 2 * bl * Cos(jd + 3.1415926 / 2)
    righttow(1) = basePnt2(1) + gd / 2 * bl * Sin(jd + 3.1415926 / 2)
   ' ThisDrawing.ModelSpace.AddLine leftlow, righttow
 
   Dim pviewportObj As AcadPViewport
    Dim center(0 To 2) As Double
    center(0) = 200: center(1) = 200: center(2) = 0
 
    ThisDrawing.ActiveSpace = acPaperSpace
    Set pviewportObj = ThisDrawing.PaperSpace.AddPViewport(center, kd, gd)
     pviewportObj.Display True
   
    pviewportObj.twistAngle = 2 * 3.1415926 - jd '旋转角度
   
    ThisDrawing.MSpace = True
    ThisDrawing.Application.ZoomWindow leftlow, righttow
    ThisDrawing.MSpace = False

   ThisDrawing.Regen acAllViewports
 
    
End Sub

学了半天时间才搞的程序。

jiapeng2008

这是一个好办法。楼主。就是知道了模型空间的矩形位置较容易在图纸空间建立新的视口。但反过来，如何将已建立了的视口对应的模型空间的范围的角点找到呢。我发现vpcoords我用不好。转出来的坐标是什么坐标。怎么不是布局里对应的点呢。差太多了。

wuyunpeng888

你要的是这个吗？

Public Sub tests()
Dim vp As AcadEntity
Set vp = ThisDrawing.Blocks.Item("*Paper_Space").Item(0)
MsgBox vp.Width & "    " & vp.Height
End Sub

wuyunpeng888

还是这个？

Public Sub tests()
Dim vp As AcadEntity, minP As Variant, maxP As Variant
Set vp = ThisDrawing.Blocks.Item("*Paper_Space").Item(0)
vp.GetBoundingBox minP, maxP
MsgBox minP(0) & "  " & minP(1) & vbNewLine & maxP(0) & "  " & maxP(1)

End Sub

jiapeng2008

楼主：

    我的视口是不规则图形，是多边形吧。我用vpcoords可以将其psdcs转到DCS ，然后再将DCS 转到WCS。我会用了。但事先要采用GetBoundingBox获得视口的各点，这点我在想。并且即使采用了GetBoundingBox，其返回的数据也并不是我的视口的最外边。不知道为什么。