填充问题
我有多个闭合线,如果一次填充的话,想单独修改某个多义线里面的填充,是不能的。有没有个东东在选闭合线填充时,各个填充的东东都能单独是个实体,方便将来单个修改???
你一个一个闭合线填充就是啦!遍历所有闭合多段线,然后一个一个填充!不难实现啊! 还是求自己好,做好了,大家分享一下
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
还有个问题,用bhatch命令时,还有个点选择模式,这步用什么方法实现好?
上面那个程序最好加一句 If Err.Number = -2145386493 Then GoTo Ne
怎么没人来指点一下,怎么可以用点选择呀
页:
[1]