如何用vba创建一个矩形?

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

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

哈哈:lol楼主加油

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那样的功能, 如不常用, 没必要编程...

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

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

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

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

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

Re: 如不常用, 没必要编程

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

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

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

本帖最后由作者于 2009-8-31 10:29:26 编辑 ntyks发表于2009-8-29 15:09:00static/image/common/back.gif呵呵，提个复杂点的：用矩形中心线上的两点呢？两点是矩形中心线与两边的交点，矩形的宽度为输入的数值。

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

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

cjb2187 发表于 2009-9-30 11:32: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写得不是太严谨,只是说明这样的程序是可以完成的,应该还有更好的办法,大家再琢磨吧

cjb2187 发表于 2009-9-30 12:13:00

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

页: [1] 2

明经CAD社区's Archiver