如何求填充边界,请教大侠
请问用哪个函数可以来求填充边界,并用多义块画出来? 是多义线,不是多义块,打错字了我查了不少书,填充边界就是很难找到,哪位能帮一下吗 有人给点提示也好呀!!!!! 以下程序只对于那些边界还关联着的填充图案有效。如果删除边界后还需要取得边界，则需要使用LISP的方法。Sub HatchBound()
Dim Ent As AcadEntity
Dim Pnt As Variant
Dim Hat As AcadHatch
Dim LoopNum As Integer
Dim i As Integer
Dim LoopObjs As Variant
Dim j As Integer
'On Error Resume Next
Do
ThisDrawing.Utility.GetEntity Ent, Pnt, vbCr & "选择填充图案："
If Err.Number <> 0 Then Exit Sub
If Ent.ObjectName = "AcDbHatch" Then Exit Do
Loop
Set Hat = Ent
LoopNum = Hat.NumberOfLoops
For i = 0 To LoopNum - 1
Debug.Print "第" & i & "个环的对象："
Hat.GetLoopAt i, LoopObjs
For j = 0 To UBound(LoopObjs)
Debug.Print LoopObjs(j).ObjectName
Next j
Next i
End Sub
给你个函数参考
'外轮廓<BR>Public Function OutBoundary(Point1 As Variant, Point2 As Variant) As AcadLWPolyline<BR> On Error Resume Next<BR> Dim PointToString As String<BR> PointToString = Trim(Str(Point1(0))) & "," & Trim(Str(Point1(1))) '转换点为字符<BR> Dim PrevTotal As Long<BR> PrevTotal = MoSpace.Count<BR> '辅助边界<BR> Dim AssistantBoundary As AcadLWPolyline<BR> Dim PntList(0 To 9) As Double<BR> PntList(0) = Point2(0): PntList(1) = Point2(1)<BR> PntList(2) = Point2(0): PntList(3) = Point2(3)<BR> PntList(4) = Point2(2): PntList(5) = Point2(3)<BR> PntList(6) = Point2(2): PntList(7) = Point2(0)<BR> PntList(8) = Point2(0): PntList(9) = Point2(1)<BR> Set AssistantBoundary = MoSpace.AddLightWeightPolyline(PntList)<BR> 'AcadDoc.SetVariable "NOMUTT", 1 '禁止不确定的消息反馈<BR> AcadDoc.SendCommand "-boundary" & vbCr & PointToString & vbCr & vbCr '调用BOUNDARY命令获取一点的边界<BR> 'AcadDoc.SetVariable "NOMUTT", 0 '恢复普通模式的消息反馈<BR> 'Sleep (1000)<BR> If MoSpace.Count > PrevTotal Then<BR> Set OutBoundary = MoSpace.Item(MoSpace.Count - 2)<BR> End If<BR> MoSpace.Item(MoSpace.Count - 1).Delete '删除辅助边界<BR> AssistantBoundary.Delete<BR>End Function
页:
[1]