新人求教 如何在块中添加填充以及如何在块中添加另一个块

桃朱红

如题，如何在块中添加填充以及如何在块中添加另一个块，尝试很久都没试出来。

桃朱红

回的人少，我来小顶一下

marting

[Visual Basic] 纯文本查看 复制代码

VBA Example 
Sub Example_AppendOuterLoop()
    ' This example creates an associative hatch in model space, and then creates an outer loop for the hatch.
    
    Dim hatchObj As AcadHatch
    Dim patternName As String
    Dim PatternType As Long
    Dim bAssociativity As Boolean
    
    ' Define the hatch
    patternName = "ANSI31"
    PatternType = 0
    bAssociativity = True
    
    ' Create the associative Hatch object
    Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
    
    ' Create the outer loop for the hatch.
    ' An arc and a line are used to create a closed loop.
    Dim outerLoop(0 To 1) As AcadEntity
    Dim center(0 To 2) As Double
    Dim radius As Double
    Dim startAngle As Double
    Dim endAngle As Double
    center(0) = 5: center(1) = 3: center(2) = 0
    radius = 1
    startAngle = 0
    endAngle = 3.141592
    Set outerLoop(0) = ThisDrawing.ModelSpace.AddArc(center, radius, startAngle, endAngle)
    Set outerLoop(1) = ThisDrawing.ModelSpace.AddLine(outerLoop(0).startPoint, outerLoop(0).endPoint)
        
    ' Append the outer loop to the hatch object, and display the hatch
    hatchObj.AppendOuterLoop (outerLoop)
    hatchObj.Evaluate
    ZoomAll
    
End Sub

marting

添加一个内部环

[Visual Basic] 纯文本查看 复制代码

VBA Example 
Sub Example_AppendInnerLoop()
    ' This example creates an associative hatch in model space, and then appends an outer loop to the hatch.
    
    Dim hatchObj As AcadHatch
    Dim patternName As String
    Dim PatternType As Long
    Dim bAssociativity As Boolean
    
    ' Define the hatch
    patternName = "ANSI31"
    PatternType = 0
    bAssociativity = True
    
    ' Create the associative Hatch object
    Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
    
    ' Create the outer loop for the hatch.
    ' An arc and a line are used to create a closed loop.
    
    Dim outerLoop(0 To 1) As AcadEntity
    Dim center(0 To 2) As Double
    Dim radius As Double
    Dim startAngle As Double
    Dim endAngle As Double
    center(0) = 5: center(1) = 3: center(2) = 0
    radius = 3
    startAngle = 0
    endAngle = 3.141592
    Set outerLoop(0) = ThisDrawing.ModelSpace.AddArc(center, radius, startAngle, endAngle)
    Set outerLoop(1) = ThisDrawing.ModelSpace.AddLine(outerLoop(0).startPoint, outerLoop(0).endPoint)
        
    ' Append the outer loop to the hatch object
    hatchObj.AppendOuterLoop (outerLoop)
    
    ' Append a circle as the inner loop for the hatch.
    Dim innerLoop(0) As AcadEntity
    center(0) = 5: center(1) = 4.5: center(2) = 0
    radius = 1
    Set innerLoop(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
    hatchObj.AppendInnerLoop (innerLoop)
    
    ' Evaluate and display the hatch
    hatchObj.Evaluate
    ThisDrawing.Regen True
    
End Sub

st788796

首先块定义是 AcDbBlockTableRecord , 在 ActiveX 中 vla-addxxx 后面的 Object 包括 ModelSpace Collection, PaperSpace Collection, Block (The objects this method applies to. ） 找到块定义后使用 vla-addxxxx 往里添加实体即可

(vla-addline (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) "myblock") ... )


块内加入另外一个块

(vla-insertblock (vla-item ...) ... )

最后记得 regen

桃朱红

marting 发表于 2017-3-20 19:59

嗯，先谢谢回复
不过，看代码，这个好像只是插入了一个填充呀，虽然我试的时候填充也没成功插入

桃朱红

st788796 发表于 2017-3-20 20:48

谢谢回复，新手，只用过VBA，上面的看不太懂

桃朱红

marting 发表于 2017-3-20 20:01

嗯，是在块中插入填充，还有就是在块中插入另一个块

桃朱红

回的人少，我来小顶一下

marting

桃朱红 发表于 2017-3-28 16:33

上面代码已经给你思路了，自己试试。

桃朱红

marting 发表于 2017-3-28 17:58

模型里插入填充这个试过的，感觉跟在块里不一样，可以举个简单的例子吗

桃朱红

回的人少，我来小顶一下

桃朱红

回的人少，我来小顶一下

yideng

很好，我试试看看

桃朱红

回的人少，我来小顶一下