请HELP，一个关于填充的问题

zgyxn

在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

mccad

你可以用GetPoint方法选 一个点，执行一次SendCommand的-bhatch来填充。
注意命令前加一个“-”号就可以不会出现对话框。

zgyxn

谢谢，如果我要选择对象又怎么用呢

zgyxn

我按你的做了，可我还觉得有很多问题，就是如果用这个命令，我不会对在选择集面的多义线一个个来填充，能教我吗

zgyxn

我用学了几天,还是不怎么会,就请高手再幚我一下吧

topirol

有这个函数来指定多义线
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 "

zgyxn

用来用去，还是觉得不太理想

bluemoon

我曾经作过填充 是这样做的
先找到你要填充呢图形的内部任意点
然后用thisdrawing.sendcommand " boundary"+所去点的坐标 此时会多一个modlespace.count
再用thisdrawing.sendcommand "-bhatch"去完成
最后再删除增加的那个count