vba块添加元素，请教大佬

翔云95 · 发表于 7 天前

tiancao100 发表于 2025-5-24 19:34
AppendEntity就不是VBA的，是吧？转VB。NET也很简单

appendentity是.net的，vba确实没有。
vba只能sendcommand了吧

tiancao100 · 发表于 7 天前

vba 还可以用 ThisDrawing.CopyObjects
比如：
Sub f_SolAddDiminBlocks()
'Workaround for Adding dimensions to block AutoCAD
   Dim po_rotDim As AcadDimAligned
   Dim po_block As AcadBlock
   Dim pd_ext1(0 To 2) As Double
   Dim pd_ext2(0 To 2) As Double
   Dim pd_lineLoc(0 To 2) As Double
   Dim po_array(0) As Object

   pd_ext1(0) = 3 : pd_ext1(1) = 3 : pd_ext1(2) = 0
   pd_ext2(0) = 10 : pd_ext2(1) = 3 : pd_ext2(2) = 0
   pd_lineLoc(0) = 5 : pd_lineLoc(1) = 4 : pd_lineLoc(2) = 0
   'create dimeionsion object
   po_rotDim = ThisDrawing.ModelSpace.AddDimAligned(pd_ext1, pd_ext2,
   pd_lineLoc)

   'create a new block by name test
   po_block = ThisDrawing.Blocks.Add(pd_ext1, "test")
   'insert a block reference
   ThisDrawing.ModelSpace.InsertBlock(pd_ext1, "test", 1, 1, 1, 0)
   'copy dimension object
   po_array(0) = po_rotDim
   ThisDrawing.CopyObjects(po_array, po_block)
   po_rotDim.Delete()
   'release the references
   po_block = Nothing
   po_rotDim = Nothing
End Sub
来自：https://adndevblog.typepad.com/a ... ject-using-vba.html

翔云95 · 发表于 6 天前

tiancao100 发表于 2025-5-24 23:21
vba 还可以用 ThisDrawing.CopyObjects
比如：
Sub f_SolAddDiminBlocks()

多谢大咖。这方法OK

在 ThisDrawing.CopyObjects(po_array, po_block) 我改为：
po_block = ThisDrawing.CopyObjects(po_array)

大咖，赞个。多谢多谢

longxh28 · 发表于 6 天前

有自动化的块应该不复杂吧。换个思路，把块写入外部一个dwg空文件内然后把块清空。在外部处理好后，再重新复制到块内。简单说就是将块内元素全部换新。

翔云95 · 发表于 6 天前

回头试试我弄个 AppendEntity函数，按这个vba的CopyObjects方式。单实体，选择集appendentity

翔云95 · 发表于 6 天前

longxh28 发表于 2025-5-25 10:30
有自动化的块应该不复杂吧。换个思路，把块写入外部一个dwg空文件内然后把块清空。在外部处理好后，再重新 ...

嗯。外部dwg方式组块读进来 , AttachExternalReference()..

这个思路也很赞

灵活。多谢大咖提示

Bao_lai · 发表于 6 天前

这个还要涉及到变换矩阵的哟~

翔云95 · 发表于 5 天前

本帖最后由翔云95 于 2025-5-26 08:48 编辑

-----

翔云95 · 发表于 5 天前

Bao_lai 发表于 2025-5-25 22:26
这个还要涉及到变换矩阵的哟~

多谢大咖提示

有链接或示例吗？

Sring65 · 发表于 4 天前

本帖最后由 Sring65 于 2025-5-27 17:47 编辑

可以试试WBlock导出文件后在块里面再插入为块

Sub Example_WBlock()
' This example creates several objects in model space and
' adds them to a selection set. This selection set is then
' output as a new drawing file.
' Create a Ray object in model space
Dim rayObj As AcadRay
Dim basePoint(0 To 2) As Double
Dim SecondPoint(0 To 2) As Double
basePoint(0) = 3#: basePoint(1) = 3#: basePoint(2) = 0#
SecondPoint(0) = 1#: SecondPoint(1) = 3#: SecondPoint(2) = 0#
Set rayObj = ThisDrawing.ModelSpace.AddRay(basePoint, SecondPoint)
' Create a polyline object in model space
Dim plineObj As AcadLWPolyline
Dim points(0 To 5) As Double
points(0) = 3: points(1) = 7
points(2) = 9: points(3) = 2
points(4) = 3: points(5) = 5
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
plineObj.Closed = True
' Create a line object in model space
Dim lineObj As AcadLine
Dim startPoint(0 To 2) As Double
Dim endPoint(0 To 2) As Double
startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0
endPoint(0) = 2: endPoint(1) = 2: endPoint(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
' Create a circle object in model space
Dim circObj As AcadCircle
Dim centerPt(0 To 2) As Double
Dim radius As Double
centerPt(0) = 20: centerPt(1) = 30: centerPt(2) = 0
radius = 3
Set circObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)
' Create an ellipse object in model space
Dim ellObj As AcadEllipse
Dim majAxis(0 To 2) As Double
Dim center(0 To 2) As Double
Dim radRatio As Double
center(0) = 5#: center(1) = 5#: center(2) = 0#
majAxis(0) = 10: majAxis(1) = 20#: majAxis(2) = 0#
radRatio = 0.3
Set ellObj = ThisDrawing.ModelSpace.AddEllipse(center, majAxis, radRatio)
ZoomAll
' Create a selection set
Dim ssetObj As AcadSelectionSet
Set ssetObj = ThisDrawing.SelectionSets.Add("WBLOCKSET")
' Iterate through the model space collection and add
' each item found to an array of objects
ReDim objsInModelSpace(0 To ThisDrawing.ModelSpace.count - 1) As AcadEntity
Dim I As Integer
For I = 0 To ThisDrawing.ModelSpace.count - 1
Set objsInModelSpace(I) = ThisDrawing.ModelSpace.Item(I)
Next
' Add the array of objects into the selection set
ssetObj.AddItems objsInModelSpace
' Output the selection set to a new file
ThisDrawing.Wblock "C:\AutoCAD\WBlock_example.dwg", ssetObj
End Sub

Sub Example_WBlock() 
    ' This example creates several objects in model space and 
    ' adds them to a selection set. This selection set is then 
    ' output as a new drawing file. 
    
    ' Create a Ray object in model space 
    Dim rayObj As AcadRay 
    Dim basePoint(0 To 2) As Double 
    Dim SecondPoint(0 To 2) As Double 
    basePoint(0) = 3#: basePoint(1) = 3#: basePoint(2) = 0# 
    SecondPoint(0) = 1#: SecondPoint(1) = 3#: SecondPoint(2) = 0# 
    Set rayObj = ThisDrawing.ModelSpace.AddRay(basePoint, SecondPoint) 
    
    ' Create a polyline object in model space 
    Dim plineObj As AcadLWPolyline 
    Dim points(0 To 5) As Double 
    points(0) = 3: points(1) = 7 
    points(2) = 9: points(3) = 2 
    points(4) = 3: points(5) = 5 
    Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points) 
    plineObj.Closed = True 
 
    ' Create a line object in model space 
    Dim lineObj As AcadLine 
    Dim startPoint(0 To 2) As Double 
    Dim endPoint(0 To 2) As Double 
    startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0 
    endPoint(0) = 2: endPoint(1) = 2: endPoint(2) = 0 
    Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint) 
    
    ' Create a circle object in model space 
    Dim circObj As AcadCircle 
    Dim centerPt(0 To 2) As Double 
    Dim radius As Double 
    centerPt(0) = 20: centerPt(1) = 30: centerPt(2) = 0 
    radius = 3 
    Set circObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius) 
 
    ' Create an ellipse object in model space 
    Dim ellObj As AcadEllipse 
    Dim majAxis(0 To 2) As Double 
    Dim center(0 To 2) As Double 
    Dim radRatio As Double 
    center(0) = 5#: center(1) = 5#: center(2) = 0# 
    majAxis(0) = 10: majAxis(1) = 20#: majAxis(2) = 0# 
    radRatio = 0.3 
    Set ellObj = ThisDrawing.ModelSpace.AddEllipse(center, majAxis, radRatio) 
 
    ZoomAll 
    
    ' Create a selection set 
    Dim ssetObj As AcadSelectionSet 
    Set ssetObj = ThisDrawing.SelectionSets.Add("WBLOCKSET") 
    
    ' Iterate through the model space collection and add 
    ' each item found to an array of objects 
    ReDim objsInModelSpace(0 To ThisDrawing.ModelSpace.count - 1) As AcadEntity 
    Dim I As Integer 
    For I = 0 To ThisDrawing.ModelSpace.count - 1 
        Set objsInModelSpace(I) = ThisDrawing.ModelSpace.Item(I) 
    Next 
    
    ' Add the array of objects into the selection set 
    ssetObj.AddItems objsInModelSpace 
    
    ' Output the selection set to a new file 
    ThisDrawing.Wblock "C:\AutoCAD\WBlock_example.dwg", ssetObj 
    
End Sub

Sub Example_AttachExternalReference()
' This example displays all the blocks in the current drawing
' before and after adding an external reference.
'
' This example uses the "city map.dwg" found in the Sample
' directory. If you do not have this drawing, or if it is
' in a different directory, insert a valid path and file name
' for the PathName variable below.
Dim InsertPoint(0 To 2) As Double
Dim insertedBlock As AcadExternalReference
Dim tempBlock As AcadBlock
Dim msg As String, PathName As String
' Define external reference to be inserted
InsertPoint(0) = 1: InsertPoint(1) = 1: InsertPoint(2) = 0
PathName = "c:\program files\autocad\sample\city map.dwg"
' Display current Block information for this drawing
GoSub ListBlocks
' Add the external reference to the drawing
Set insertedBlock = ThisDrawing.ModelSpace.AttachExternalReference(PathName, "XREF_IMAGE", InsertPoint, 1, 1, 1, 0, False)
ThisDrawing.Application.ZoomAll
' Display new Block information for this drawing
GoSub ListBlocks
Exit Sub
ListBlocks:
msg = vbCrLf ' Reset message
For Each tempBlock In ThisDrawing.Blocks
msg = msg & tempBlock.name & vbCrLf ' Add Block to list
Next
MsgBox "The current blocks in this drawing are: " & msg
Return
End Sub

Sub Example_AttachExternalReference() 
    ' This example displays all the blocks in the current drawing 
    ' before and after adding an external reference. 
    ' 
    ' This example uses the "city map.dwg" found in the Sample 
    ' directory. If you do not have this drawing, or if it is 
    ' in a different directory, insert a valid path and file name 
    ' for the PathName variable below. 
    
    Dim InsertPoint(0 To 2) As Double 
    Dim insertedBlock As AcadExternalReference 
    Dim tempBlock As AcadBlock 
    Dim msg As String, PathName As String 
    
    ' Define external reference to be inserted 
    InsertPoint(0) = 1: InsertPoint(1) = 1: InsertPoint(2) = 0 
    PathName = "c:\program files\autocad\sample\city map.dwg" 
    
    ' Display current Block information for this drawing 
    GoSub ListBlocks 
    
    ' Add the external reference to the drawing 
    Set insertedBlock = ThisDrawing.ModelSpace.AttachExternalReference(PathName, "XREF_IMAGE", InsertPoint, 1, 1, 1, 0, False) 
         
    ThisDrawing.Application.ZoomAll 
    
    ' Display new Block information for this drawing 
    GoSub ListBlocks 
    
    Exit Sub 
 
ListBlocks: 
    msg = vbCrLf    ' Reset message 
    
    For Each tempBlock In ThisDrawing.Blocks 
        msg = msg & tempBlock.name & vbCrLf     ' Add Block to list 
    Next 
    
    MsgBox "The current blocks in this drawing are: " & msg 
    
    Return 
End Sub

Sub Example_Bind()
On Error GoTo ERRORHANDLER
' Define external reference to be inserted
Dim xrefHome As AcadBlock
Dim xrefInserted As AcadExternalReference
Dim insertionPnt(0 To 2) As Double
Dim PathName As String
insertionPnt(0) = 1
insertionPnt(1) = 1
insertionPnt(2) = 0
PathName = "c:/AutoCAD/sample/City map.dwg"
' Add the external reference
Set xrefInserted = ThisDrawing.ModelSpace. _
AttachExternalReference(PathName, "XREF_IMAGE", _
insertionPnt, 1, 1, 1, 0, False)
ZoomAll
MsgBox "The external reference is attached."
' Bind the external reference definition
ThisDrawing.Blocks.Item(xrefInserted.name).Bind False
MsgBox "The external reference is bound."
Exit Sub
ERRORHANDLER:
MsgBox Err.Description
End Sub

Sub Example_Bind() 
    On Error GoTo ERRORHANDLER 
                           
    ' Define external reference to be inserted 
    Dim xrefHome As AcadBlock 
    Dim xrefInserted As AcadExternalReference 
    Dim insertionPnt(0 To 2) As Double 
    Dim PathName As String 
    insertionPnt(0) = 1 
    insertionPnt(1) = 1 
    insertionPnt(2) = 0 
    PathName = "c:/AutoCAD/sample/City map.dwg" 
    
    ' Add the external reference 
    Set xrefInserted = ThisDrawing.ModelSpace. _ 
            AttachExternalReference(PathName, "XREF_IMAGE", _ 
            insertionPnt, 1, 1, 1, 0, False) 
    ZoomAll 
    MsgBox "The external reference is attached." 
    
    ' Bind the external reference definition 
    ThisDrawing.Blocks.Item(xrefInserted.name).Bind False 
    MsgBox "The external reference is bound." 
    Exit Sub 
ERRORHANDLER: 
    MsgBox Err.Description 
End Sub

账号		自动登录	找回密码
密码			注册