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

fjfhgdwfn 发表于 2009-2-10 11:30:00

现在图纸空间有一个矩形视口，如何得到这四个角点在模型空间的坐标。即如何根据模型空间的一个矩形，新建一个视口正好与这个矩形相重合。看了下帮助，好像没有讲视口显示的模型空间的基点啊！

fjfhgdwfn 发表于 2009-2-10 13:47:00

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 发表于 2009-2-27 18:55:00

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

fjfhgdwfn 发表于 2009-2-27 20:02:00

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

jiapeng2008 发表于 2009-2-27 21:35:00

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

fjfhgdwfn 发表于 2009-2-27 22:18:00

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 发表于 2009-2-27 22:37:00

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

wuyunpeng888 发表于 2009-2-27 23:27:00

你要的是这个吗？Public Sub tests() Dim vp As AcadEntity Set vp = ThisDrawing.Blocks.Item("*Paper_Space").Item(0) MsgBox vp.Width & "    " & vp.Height End Sub

wuyunpeng888 发表于 2009-2-27 23:31:00

还是这个？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 发表于 2009-2-27 23:48:00

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

页: [1] 2

明经CAD社区's Archiver

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