自动填充的，出错了，帮忙看看！！
Sub test()Dim hatchObj As AcadHatch
Dim patternName As String
Dim PatternType As Long
Dim bAssociativity As Boolean
Dim outerLoop(0 To 0) As AcadEntity
' 定义图案填充
patternName = "ANSI31"
PatternType = 0
bAssociativity = True
' 当前图纸的实体数目
Dim n As Long
n = ThisDrawing.ModelSpace.Count
' 调用BOUNDARY命令获取某一点处的边界
Dim Pt As Variant
Pt = ThisDrawing.Utility.GetPoint(, "指定内部点: ")
ThisDrawing.SendCommand "_-Boundary" & vbCr & Pt(0) & "," & Pt(1) & vbCr & vbCr
' 如果存在边界，则会生成新的实体
Dim lwpLineObj As AcadLWPolyline
If ThisDrawing.ModelSpace.Count > n Then
Set lwpLineObj = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)
MsgBox lwpLineObj.Area
' lwpLineObj.Delete
lwpLineObj.Closed = True
Else
MsgBox "未发现有效的边界。"
End If
outerLoop(0) = lwpLineObj
hatchObj.AppendOuterLoop (outerLoop)
hatchObj.Evaluate
ObjDoc.Regen True
End Sub
解决了，
需要加Boundary命令前加个zoomall命令
我想楼主个问题
在对面域填充时
当面域为不连续或为环状时则不能正常填充（利用快速选择能选中图案填充，就是不能显示）
Dim i As Long
Dim hatchObj As AcadHatch
Dim patternName As String
Dim patternType As Long
Dim assocVar As Boolean
Dim outerLoop(0 To 0) As AcadEntity
Dim eNt As AcadEntity
Dim sset As AcadSelectionSet
Dim outerLoop1(0 To 0) As AcadEntity
Dim n As Long
Dim Pt As Variant
patternName = "SOLID"
patternType = acHatchPatternTypePreDefined
assocVar = True
n = ThisDrawing.ModelSpace.Count
Pt = ThisDrawing.Utility.GetPoint(, "指定内部点: ")
ThisDrawing.SendCommand "_-Boundary" & vbCr & Pt(0) & "," & Pt(1) & vbCr & vbCr
If ThisDrawing.ModelSpace.Count > n Then
Set outerLoop1(0) = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)
Else
MsgBox "未发现有效的边界。"
End If
Set sset = ThisDrawing.SelectionSets.Add("ss7")
sset.AddItems outerLoop1
For Each eNt In sset
Set outerLoop(0) = eNt
Set hatchObj = ThisDrawing.ModelSpace.AddHatch(patternType, patternName, assocVar)
hatchObj.AppendOuterLoop (outerLoop)
hatchObj.Evaluate
Next
sset.Delete
ThisDrawing.Regen True
页:
[1]