社区 › VB › 如何用vba创建一个矩形?

shicai 发表于 2002-11-28 11:29:00

如何用vba创建一个矩形?

懸懸懸 发表于 2021-2-11 17:26:00

哈哈楼主加油

mccad 发表于 2002-11-28 21:29:00

'通过对角两点绘制矩形的函数
Function AddRectangle(varPnt1 As Variant, varPnt2 As Variant) As AcadLWPolyline
On Error GoTo Err_Control

Dim objSpace As AcadBlock
    If ThisDrawing.ActiveSpace = acModelSpace Then
      Set objSpace = ThisDrawing.ModelSpace
    Else
      Set objSpace = ThisDrawing.PaperSpace
    End If
      
    Dim plineObj As AcadLWPolyline
    Dim points(0 To 7) As Double
   
    points(0) = varPnt1(0): points(1) = varPnt1(1)
    points(2) = varPnt1(0): points(3) = varPnt2(1)
    points(4) = varPnt2(0): points(5) = varPnt2(1)
    points(6) = varPnt2(0): points(7) = varPnt1(1)
   
    Set plineObj = objSpace.AddLightWeightPolyline(points)
      plineObj.Closed = True
    Set AddRectangle = plineObj
            
Exit_Here:
Exit Function

Err_Control:
Resume Exit_Here
End Function
Sub addrec()
Dim pnt1 As Variant
Dim pnt2 As Variant
pnt1 = ThisDrawing.Utility.GetPoint(, "请输入角点：")
pnt2 = ThisDrawing.Utility.GetCorner(pnt1, "请输入另一角点：")
AddRectangle pnt1, pnt2

End Sub

shicai 发表于 2002-12-3 05:46:00

看来VBA没有像Lisp中Rectangle那样的功能, 如不常用, 没必要编程, 用addline罢了.

zhuqi75 发表于 2003-1-23 13:24:00

你这人真是的，人家好心给你程序，你却。。。。

efan2000 发表于 2003-1-23 19:57:00

你不是要用VB创建矩形吗，既然自己不编写，而又不需要别人的，那你到底想怎么做？

ntyks 发表于 2009-8-29 15:09:00

请将需求,用数学表达式表示出来。

兰州人 发表于 2009-8-29 17:37:00

Sub addrec()
    Dim pt(1 To 2) As Variant
    Dim pt1(14) As Double
    Dim Recobj As AcadPolyline
    Dim l, s, XDiffer, YDiffer, sca As Double
    l = 5
    pt(1) = ThisDrawing.Utility.GetPoint(, "请输入矩形第一条宽边的中心点")
    pt(2) = ThisDrawing.Utility.GetPoint(, "请输入矩形第二条宽边的中心点")
    XDiffer = pt(2)(0) - pt(1)(0)
    YDiffer = pt(2)(1) - pt(1)(1)
    s = (XDiffer ^ 2 + YDiffer ^ 2) ^ (1 / 2)
    sca = l / 2 / s
    pt1(0) = pt(1)(0) - YDiffer * sca
    pt1(1) = pt(1)(1) + XDiffer * sca
    pt1(2) = 0#
    pt1(3) = pt(1)(0) + YDiffer * sca
    pt1(4) = pt(1)(1) - XDiffer * sca
    pt1(5) = 0#
    pt1(6) = pt(2)(0) + YDiffer * sca
    pt1(7) = pt(2)(1) - XDiffer * sca
    pt1(8) = 0#
    pt1(9) = pt(2)(0) - YDiffer * sca
    pt1(10) = pt(2)(1) + XDiffer * sca
    pt1(11) = 0#
    pt1(12) = pt1(0)
    pt1(13) = pt1(1)
    pt1(14) = pt1(2)
    Set Recobj = ThisDrawing.ModelSpace.AddPolyline(pt1)
    Recobj.Update
End Sub
写得不是太严谨,只是说明这样的程序是可以完成的,应该还有更好的办法,大家再琢磨吧

ntyks 发表于 2009-9-29 14:41:00

我觉得还有一个办法,但是没有试验过,思路如下:
1)新建一个坐标系,要求所点的两个点Y值相同(相对于世界坐标旋转一个角度)
2)获得第三个点,坐标是第一个点Y值减2.5
3)获得第四个点,坐标是第二个点Y值加2.5
4)按此两点画一个矩形(这应该不难)
5)把坐标转回来,仍使用世界坐标

查看完整版本: 如何用vba创建一个矩形?