VB新手请教个问题，为什么用轻便多义线画出来的矩形不能填充。

也许有一天

    Dim HatchObj As AcadHatch
    Dim PatternName As String
    Dim PatternType As Long
    Dim bAssociativity As Boolean
    PatternType = 0
    PatternName = "ANGLE"
    bAssociativity = True
    Set HatchObj = acadapp.ActiveDocument.ModelSpace.AddHatch(PatternType, PatternName, bAssociativity)

  Dim Ld1 As AcadLWPolyline
  Dim Ld2 As AcadSolid

    syu(0) = 0: syu(1) = 0
   syu(2) = 200: syu(3) = 0
   syu(4) = 200: syu(5) = 200
   syu(6) = 0: syu(7) = 200
   syu(8) = 0: syu(9) = 0

    Set Ld1 = acaddoc.ModelSpace.AddLightWeightPolyline(syu)
    HatchObj.AppendOuterLoop (Ld1)
    HatchObj.Evaluate
    acadapp.ActiveDocument.Regen True

yshf

    Dim AcadDoc As Object
    Dim HatchObj As AcadHatch
    Dim PatternName As String
    Dim PatternType As Long
    Dim bAssociativity As Boolean
   
    PatternType = 0
    PatternName = "ANGLE"
    bAssociativity = True
   
    Set AcadDoc = ThisDrawing
    Set HatchObj = AcadDoc.ModelSpace.AddHatch(PatternType, PatternName, bAssociativity, 0)
   
    Dim outerLoop(0 To 0) As AcadEntity
    Dim syu(0 To 9) As Double
    syu(0) = 0: syu(1) = 0
    syu(2) = 200: syu(3) = 0
    syu(4) = 200: syu(5) = 200
    syu(6) = 0: syu(7) = 200
    syu(8) = 0: syu(9) = 0

    Set outerLoop(0) = AcadDoc.ModelSpace.AddLightWeightPolyline(syu)
   
    HatchObj.AppendOuterLoop (outerLoop)
    HatchObj.Evaluate
    AcadDoc.Regen True

也许有一天

yshf 发表于 2020-5-25 14:24
Dim AcadDoc As Object
    Dim HatchObj As AcadHatch
    Dim PatternName As String

谢谢您，再问一下，我如果想控制填充的颜色该添加什么语句呢？

yshf

    Dim AcadDoc As Object
    Dim HatchObj As AcadHatch
    Dim PatternName As String
    Dim PatternType As Long
    Dim bAssociativity As Boolean
   
    PatternType = 0
    PatternName = "ANGLE"
    bAssociativity = True
   
    Set AcadDoc = ThisDrawing
    Set HatchObj = AcadDoc.ModelSpace.AddHatch(PatternType, PatternName, bAssociativity, 0)
    HatchObj.color = 1 '红色
   
    Dim outerLoop(0 To 0) As AcadEntity
    Dim syu(0 To 9) As Double
    syu(0) = 0: syu(1) = 0
    syu(2) = 200: syu(3) = 0
    syu(4) = 200: syu(5) = 200
    syu(6) = 0: syu(7) = 200
    syu(8) = 0: syu(9) = 0

    Set outerLoop(0) = AcadDoc.ModelSpace.AddLightWeightPolyline(syu)
   
    HatchObj.AppendOuterLoop (outerLoop)
    HatchObj.Evaluate
    AcadDoc.Regen True

也许有一天

yshf 发表于 2020-5-25 20:18
Dim AcadDoc As Object
    Dim HatchObj As AcadHatch
    Dim PatternName As String

非常感谢

也许有一天

yshf 发表于 2020-5-25 20:18
Dim AcadDoc As Object
    Dim HatchObj As AcadHatch
    Dim PatternName As String

你好，想再次请教一下，如果想填充RGB颜色需要更改哪里，谢谢。