请教大家关于偏移的问题
我想通过以下代码画一个矩形，然后再偏移一下，总是得到怪怪的结果，请那位大侠帮忙查一下原因，改变矩形四个点的坐标后，有时候却能得到正确的结果，难道offset命令还与源对象的坐标有关？另外我请问一下，要画一个矩形有没有更简捷的命令？？Private Sub Command1_Click()
Dim plineobj As AcadLWPolyline
Dim points(0 To 7) As Double
On Error Resume Next '以下调用autocad2004
Set CadApp = GetObject(, "AutoCAD.Application")
If Err Then
Err.Clear
Set CadApp = CreateObject("AutoCAD.Application")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
CadApp.Application.Visible = True
Set CadDoc = CadApp.ActiveDocument
points(0) = 2745
points(1) = 600
points(2) = 12177
points(3) = 600
points(4) = 12177
points(5) = -1620
points(6) = 2745
points(7) = -1620
Set plineobj = CadDoc.ModelSpace.AddLightWeightPolyline(points)
plineobj.Closed = True
plineobj.Offset -60
End Sub 我是了一下没有出现你说的情况。
矩形绘制程序入内
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
页:
[1]