也许有一天 发表于 2020-5-25 11:05:45

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 发表于 2020-5-25 14:24:51

    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

也许有一天 发表于 2020-5-25 16:51:28

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


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

yshf 发表于 2020-5-25 20:18:09

    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

也许有一天 发表于 2020-5-25 21:08:11

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


非常感谢:loveliness:

也许有一天 发表于 2020-9-14 17:31:37

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


你好，想再次请教一下，如果想填充RGB颜色需要更改哪里，谢谢。
页: [1]
查看完整版本: VB新手请教个问题，为什么用轻便多义线画出来的矩形不能填充。