我想在cad上画矩形框后,怎么在vba中得到矩形的左下角和右上角坐标?

gaich · 发表于 2002-7-18 19:31:00

我是刚学vba,我想实现的功能是这样的:
运行一个宏,然后画一个临时的框进行选择,然后能在vba中得到临时框的坐标,怎么去实现哪?
我都弄了一天了,也没实现,没什么思路,请大家帮帮忙吧,谢谢了!!!

mccad · 发表于 2002-7-18 19:54:00

Sub gcorner()
Dim FstPnt As Variant
Dim SndPnt As Variant
FstPnt = ThisDrawing.Utility.GetPoint(, "选取矩形第一角点：")
SndPnt = ThisDrawing.Utility.GetCorner(FstPnt, "选取矩形对角点：")
MsgBox "矩形框的坐标如下：" & vbCrLf & _
"第一角点的坐标为" & FstPnt(0) & ", " & FstPnt(1) & ", " & FstPnt(2) & vbCrLf & _
"第二角点的坐标为" & SndPnt(0) & ", " & SndPnt(1) & ", " & SndPnt(2), , "矩形框坐标"
End Sub

gaich · 发表于 2002-7-19 12:39:00

版主,太谢谢了,就是这个意思,我还问一下,怎么去画多边形,并取得点的坐标?

mccad · 发表于 2002-7-19 21:51:00

Sub polygon()
'以下语句绘制正多边形
Dim num As Integer
Dim pnt As Variant
Dim lpnt As Variant
num = ThisDrawing.Utility.GetInteger("请选择正多边形的边数：")
Dim fpnt As Variant
fpnt = ThisDrawing.Utility.GetPoint(, "请选择正多边形的起点：")
Dim leng As Double
leng = ThisDrawing.Utility.GetDistance(fpnt, "请选择正多边形的边长：")
ReDim lpnt(0 To num * 2 - 1) As Double
pnt = fpnt
lpnt(0) = pnt(0)
lpnt(1) = pnt(1)
Dim st As Integer
For st = 1 To num - 1
      pnt = ThisDrawing.Utility.PolarPoint(pnt, (3.14159265 * 2 / num) * (st - 1), leng)
      lpnt(st * 2) = pnt(0)
      lpnt(st * 2 + 1) = pnt(1)
Next st
Dim pgon As AcadLWPolyline
Set pgon = ThisDrawing.ModelSpace.AddLightWeightPolyline(lpnt)
pgon.Closed = True
ThisDrawing.Regen (True)
'以下语句获取多边形的顶点
Dim gpnt As Variant
gpnt = pgon.Coordinates
Dim pntcnt As Integer
pntcnt = UBound(gpnt)
Dim disptxt As String
disptxt = "多边形共有" & (pntcnt + 1) / 2 & "个顶点" & vbCrLf
Dim i As Integer
For i = 0 To pntcnt - 1 Step 2
      disptxt = disptxt & "第" & i / 2 + 1 & "个顶点的坐标为:" & _
            gpnt(i) & "," & gpnt(i + 1) & vbCrLf
Next i
disptxt = disptxt & "乐筑天下VBA示例 http://www.mjtd.com"
MsgBox disptxt, , "多边形的坐标显示"
End Sub

我想在cad上画矩形框后,怎么在vba中得到矩形的左下角和右上角坐标?

发表回复

精选推荐