如何用vba插入块？？
我有一个子例程，它应该定义和声明一个块，向其中添加元素，然后将其插入当前图形中的指定位置。问题是它只在第一次正常工作。之后，在相对于给定插入点的相对位置插入不同数量的块。感谢您的帮助。子例程如下所示：Public Sub BlocCota(pIn As Variant, valCota As Double)
'Pt hasura
Dim outerLoop(0 To 0) As AcadEntity
Dim hasura As AcadHatch
Dim hasuraPattern As AcPatternType
Dim hasuraName As String
'pt restul
Dim myBloc As AcadBlock
Dim linie As AcadLine
Dim myPoly As AcadPolyline
Dim myText As AcadText
Dim colPuncte(0 ToAs Double
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
Dim s As String
s = CStr(valCota)
'Adaugam blocul la desen
Dim contor As Integer
Dim b As Boolean
Dim vX As Integer
b = True
contor = ThisDrawing.Blocks.Count - 1
Dim ind As Integer
For ind = 0 To contor Step 1
If ThisDrawing.Blocks.Item(ind).Name = "sageataNivel" Then
b = False
vX = ind
End If
Next ind
If b = True Then
Set myBloc = ThisDrawing.Blocks.Add(pIn, "sageataNivel")
Else
Set myBloc = ThisDrawing.Blocks.Item(vX)
End If
'Linia ____ de inceput
p1(0) = pIn(0)
p1(1) = pIn(1)
p1(2) = pIn(2)
p2(0) = p1(0) + 5
p2(1) = p1(1)
p2(2) = p1(2)
Set linie = myBloc.AddLine(p1, p2)
'Triunghiul din stanga
colPuncte(0) = p2(0)
colPuncte(1) = p2(1)
colPuncte(2) = p2(2)
colPuncte(3) = colPuncte(0)
colPuncte(4) = colPuncte(1) + 5
colPuncte(5) = colPuncte(2)
colPuncte(6) = colPuncte(3) - 5
colPuncte(7) = colPuncte(4)
colPuncte( = colPuncte(5)
Set myPoly = myBloc.AddPolyline(colPuncte)
myPoly.Closed = True
'Triunghiul din dreapta
colPuncte(0) = colPuncte(0)
colPuncte(1) = colPuncte(1)
colPuncte(2) = colPuncte(2)
colPuncte(3) = colPuncte(0)
colPuncte(4) = colPuncte(1) + 5
colPuncte(5) = colPuncte(2)
colPuncte(6) = colPuncte(3) + 5
colPuncte(7) = colPuncte(4)
colPuncte( = colPuncte(5)
Set myPoly = myBloc.AddPolyline(colPuncte)
myPoly.Closed = True
Set outerLoop(0) = myPoly
hasuraPattern = acHatchPatternTypePreDefined
hasuraName = "SOLID"
Set hasura = ThisDrawing.ModelSpace.AddHatch(hasuraPattern, hasuraName, True)
hasura.AppendOuterLoop (outerLoop)
hasura.Evaluate
'Linia |
p1(0) = p2(0)
p1(1) = p2(1)
p1(2) = p2(2)
p2(0) = p2(0)
p2(1) = p2(1) + 15
p2(2) = p2(2)
Set linie = myBloc.AddLine(p1, p2)
'Linia ------
p1(0) = p2(0)
p1(1) = p1(1) + 5
p1(2) = p1(2)
p2(0) = p1(0) + 15
p2(1) = p1(1)
p2(2) = p1(2)
Set linie = myBloc.AddLine(p1, p2)
'Textul
p1(0) = p1(0) + 3
p1(1) = p1(1) + 3
p1(2) = p1(2)
Set myText = myBloc.AddText(s, p1, 7)
'Inseram blocul in punctul dat
Dim myBlocRef As AcadBlockReference
Set myBlocRef = ThisDrawing.ModelSpace.InsertBlock(pIn, "sageataNivel", 1#, 1#, 1#, 0)
myBlocRef.Layer = "cote"
End Sub
该例程将相似的几何图形添加到现有块中。这意味着引用该块的任何插入也将包括该新几何体。
这可能是一种选择（见下文）。如果每个块参照需要不同的值（valCota），则应将其设置为属性。
Public Sub BlocCota(pIn As Variant, valCota As Double)
'Pt hasura
Dim outerLoop(0 To 0) As AcadEntity
Dim hasura As AcadHatch
Dim hasuraPattern As AcPatternType
Dim hasuraName As String
'pt restul
Dim myBloc As AcadBlock
Dim linie As AcadLine
Dim myPoly As AcadPolyline
Dim myPoly2 As AcadPolyline
Dim myText As AcadText
Dim colPuncte(0 ToAs Double
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
Dim s As String
s = CStr(valCota)
'Adaugam blocul la desen
Dim contor As Integer
Dim b As Boolean
Dim vX As Integer
b = True
contor = ThisDrawing.Blocks.Count - 1
Dim ind As Integer
For ind = 0 To contor Step 1
If ThisDrawing.Blocks.Item(ind).Name = "sageataNivel" Then
b = False
vX = ind
Exit For
End If
Next ind
'Linia ____ de inceput
p1(0) = pIn(0)
p1(1) = pIn(1)
p1(2) = pIn(2)
p2(0) = p1(0) + 5
p2(1) = p1(1)
p2(2) = p1(2)
'Triunghiul din stanga
colPuncte(0) = p2(0)
colPuncte(1) = p2(1)
colPuncte(2) = p2(2)
colPuncte(3) = colPuncte(0)
colPuncte(4) = colPuncte(1) + 5
colPuncte(5) = colPuncte(2)
colPuncte(6) = colPuncte(3) - 5
colPuncte(7) = colPuncte(4)
colPuncte( = colPuncte(5)
If b = True Then
Set myBloc = ThisDrawing.Blocks.Add(pIn, "sageataNivel")
Set linie = myBloc.AddLine(p1, p2)
Set myPoly = myBloc.AddPolyline(colPuncte)
myPoly.Closed = True
'Linia |
p1(0) = p2(0)
p1(1) = p2(1)
p1(2) = p2(2)
p2(0) = p2(0)
p2(1) = p2(1) + 15
p2(2) = p2(2)
Set linie = myBloc.AddLine(p1, p2)
'Linia ------
p1(0) = p2(0)
p1(1) = p1(1) + 5
p1(2) = p1(2)
p2(0) = p1(0) + 15
p2(1) = p1(1)
p2(2) = p1(2)
Set linie = myBloc.AddLine(p1, p2)
'Textul
p1(0) = p1(0) + 3
p1(1) = p1(1) + 3
p1(2) = p1(2)
Set myText = myBloc.AddText(s, p1, 7)
Else
Set myBloc = ThisDrawing.Blocks.Item(vX)
End If
Set myPoly2 = ThisDrawing.ModelSpace.AddPolyline(colPuncte)
myPoly2.Closed = True
Set outerLoop(0) = myPoly2
hasuraPattern = acHatchPatternTypePreDefined
hasuraName = "SOLID"
Set hasura = ThisDrawing.ModelSpace.AddHatch(hasuraPattern, hasuraName, True)
hasura.AppendOuterLoop (outerLoop)
hasura.Evaluate
'Inseram blocul in punctul dat
Dim myBlocRef As AcadBlockReference
Set myBlocRef = ThisDrawing.ModelSpace.InsertBlock(pIn, "sageataNivel", 1#, 1#, 1#, 0)
myBlocRef.Layer = "cote"
End Sub 我认为变量“pIn”有不同的位置需求。一个是块“definition”（add）中的插入点
设置myBloc=ThisDrawing。阻碍。添加（pIn，“sageataNivel”）
例程末端的另一个实例是它在图形中作为块“参考”（插入）的位置
设置myBlocRef=ThisDrawing。模型空间。插入块（引脚，“sageataNivel”，1#，1#，1#，0）
如果在“blockdefinition”和“blockreference”的调用中，Pin始终为0,0，那么没有问题，
但当所选输入发生变化时，在第二次、第三次、第四次插入时，在放置“块参考”的图形中，在第二个插脚调用插入时，
添加时，它也会相对于原始调用在其“定义”中的位置进行更改（当我假设pIn发生变化时，基本上在第二、第三、第四次调用中重新定义）。
它是否将块“参考”的预期插入的x、y值，甚至可能是x2、第二、第三、第四个序列置换？
“pIn\u Def”和“pIn\u Ref”是必需的，我猜是独立的值，pIn\u Def应该是最终的，相对于块“定义”本身。
或者您添加（定义）一次，并且从不重新定义它的“定义”，随后调用在图形中的第二、第三、第四个插入处固定为“参考”
页:
[1]