请教大家关于偏移的问题

zhy_li · 发表于 2003-8-2 20:18:00

我想通过以下代码画一个矩形，然后再偏移一下，总是得到怪怪的结果，请那位大侠帮忙查一下原因，改变矩形四个点的坐标后，有时候却能得到正确的结果，难道offset命令还与源对象的坐标有关？另外我请问一下，要画一个矩形有没有更简捷的命令？？
Private Sub Command1_Click()
Dim plineobj As AcadLWPolyline
Dim points(0 To 7) As Double
On Error Resume Next       '以下调用2004
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

HQ_2003 · 发表于 2003-8-4 13:07: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

请教大家关于偏移的问题

发表回复

精选推荐