请HELP，一个关于填充的问题
在cad 中如果一次选多个实体填充，那么填充出来的块会是一个整体，不能单独编缉，我刚开始想把多义线坐标提出来，然后一个个填充就可以，可是做出来可不是这一回事，因为如果多义线有弧线，就不行了，大家可不可以帮我一下，我想如果直接用send command :bhatch,怎么去掉它的对话框呢？可不可帮我一下，下面是我最初做的程序Option Explicit
Dim coorDi() As Double
Dim coorDiB() As Double
Dim coorDiC As Variant
Dim j As Integer
Dim lowBiao, upBiao As Integer
Dim appobj As AcadApplication
Dim dwgfile As AcadDocument
Dim i As Integer
Dim sset, ent As Object
Dim hatchObj As AcadHatch
Dim patternName As String
Dim patternType As Long
Dim assocVar As Boolean
Dim outerLoop(0 To 0) As AcadEntity
Sub bhy()
On Error Resume Next '转到错误控制
patternType = 0
patternName = "ANSI31"
assocVar = True
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")
selec:
sset.SelectOnScreen
For Each ent In sset
Rem j = MsgBox(Err.Number, vbInformation, "fl")
If ent.ObjectName = "AcDbPolyline" Or ent.ObjectName = "AcDbLWPolyline" Then
coorDiB = ent.Coordinates
upBiao = UBound(coorDiB, 1)
ReDim coorDi(upBiao + 2)
coorDiC = ent.Coordinates
For j = 0 To upBiao
coorDi(j) = coorDiC(j)
Next j
coorDi(upBiao + 1) = coorDiC(0)
coorDi(upBiao + 2) = coorDiC(1)
Set hatchObj = ThisDrawing.ModelSpace.AddHatch(patternType, patternName, assocVar)
Set outerLoop(0) = ThisDrawing.ModelSpace.AddLightWeightPolyline(coorDi)
hatchObj.AppendOuterLoop (outerLoop)
hatchObj.Evaluate
End If
Next
Rem ThisDrawing.Regen True
en: End Sub 你可以用GetPoint方法选 一个点，执行一次SendCommand的-bhatch来填充。
注意命令前加一个“-”号就可以不会出现对话框。 谢谢，如果我要选择对象又怎么用呢 我按你的做了，可我还觉得有很多问题，就是如果用这个命令，我不会对在选择集面的多义线一个个来填充，能教我吗 我用学了几天,还是不怎么会,就请高手再幚我一下吧 有这个函数来指定多义线
Public Function axEnt2lspEnt(entObj As AcadEntity) As String
Dim entHandle As String
entHandle = entObj.Handle
axEnt2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function
比如：
thisdrawing.sendcommond "move " & axEnt2lspEnt(pline_qqq) &"0,0,0 " & "100,100,0 " 用来用去，还是觉得不太理想 我曾经作过填充 是这样做的
先找到你要填充呢图形的内部任意点
然后用thisdrawing.sendcommand " boundary"+所去点的坐标 此时会多一个modlespace.count
再用thisdrawing.sendcommand "-bhatch"去完成
最后再删除增加的那个count
页:
[1]