|
|
发表于 2007-7-15 16:18:00
|
显示全部楼层
还是求自己好,做好了,大家分享一下
Public Sub bha() '快速填充
Dim poinTs As Variant
Dim varinSp As Variant
Dim dbLp(2) As Double
Dim hatchObj As AcadHatch
Dim patternName As String
Dim patternType As Long
Dim assocVar As Boolean
Dim upBiao As Integer
patternName = "SOLID"
Dim outerLoop(0 To 0) As AcadEntity
Dim eNt As AcadEntity
patternType = acHatchPatternTypePreDefined
assocVar = True
'*************开始程序*************
'On Error GoTo Err_Control
selec:
If ThisDrawing.SelectionSets.Count > 0 Then
For i = 0 To ThisDrawing.SelectionSets.Count - 1
ThisDrawing.SelectionSets.Item(i).Delete
Next i
End If
Set sSet = ThisDrawing.SelectionSets.add("ss1")
sSet.SelectOnScreen
For Each eNt In sSet
Set outerLoop(0) = eNt
Set hatchObj = ThisDrawing.ModelSpace.AddHatch(patternType, patternName, assocVar)
hatchObj.AppendOuterLoop (outerLoop)
hatchObj.Evaluate
Next
'ThisDrawing.Regen True
end
|
|
置顶卡
