循环时无法在autocad中添加文本。

Suresh_nair · 发表于 2016-5-10 12:12:23

嗨，朋友们，
VBA新手，因此请原谅我的无知。
我有一个excel电子表格，用于在多个视图中创建一个图形（实际上是嵌套在大框的不同视图中的多个面板，即前视图/侧视图/顶部等）。我画完了面板。这部分还可以。
现在，当涉及到填充每个面板上方的面板尺寸时，我遇到了一个问题。当代码在循环之外工作时，代码工作正常，但当我尝试循环它时....没有运气。有人可以帮忙吗？
代码看起来像这样。
公共函数 Rectangle1（插入点作为变体，宽度作为双精度，高度作为双精度）作为 AcadLWPolyline
Dim VerticesList（0 To 15）作为双
顶点列表（0） = 插入点（0）：顶点列表（1） = 插入点（1）
顶点列表（2） = 插入点（0）：顶点列表（3） = 插入点（1） + 高度
顶点列表（4） = 插入点（0） + 宽度：顶点列表（5） = 插入点（1） + 高度
顶点列表（6） = 插入点（0） + 宽度：顶点列表（7） = 插入点（1）
VerticesList（ = insertionPoint（0）： VerticesList（9） = insertionPoint（1）
VerticesList（10） = insertionPoint（0） + Width： VerticesList（11） = insertionPoint（1） + height
VerticesList（12） = insertionPoint（0）： VerticesList（13） = insertPoint（1） + height
VerticesList（14） = insertionPoint（0） + Width： VerticesList（15） = insertionPoint（1）
Set Rectangle1 = ActiveDocument.ModelSpace.AddLightWeightPolyline（VerticesList）
Rectangle1.Closed = True
Rectangle1.Update
End函数
公共函数 AddText（textstring As String， insertionPoint As Variant， height As Double）

Dim textObj As AcadText
Dim textstring As String
Dim insertPoint（0 To 2） As Double

Dim Height As Double height = 100

insertionPoint（0） = 2： insertionPoint（1） = 2： insertionPoint（2） = 0
textstring = MyHeight & “ x ” & MyWidth

Set textObj = ActiveDocument.ModelSpace.AddText（textstring， insertionPoint， height）'- 我尝试调用此行 ito 我的循环
结束函数
Sub test_rectangle（）
Dim insertionPoint（1） As Variant
Dim MyWidth As Double
Dim MyHeight As Double
Dim MyRectangle As AcadLWPolyline
Dim i， j As Integer
Dim xoffset As Double
Dim yoffset As Double
Dim textObj1 As AcadText
'-------------------------FRONT
insertPoint（0） = 0
insertPoint（1） = 0
MyHeight = Sheets（“sheet1”）。Cells（10， 2）
MyWidth = Sheets（“sheet1”）。Cells（11， 2）
Set MyRectangle = Rectangle2（insertionPoint， MyWidth， MyHeight）
insertionPoint（0） = -35
insertionPoint（1） = -35
Set MyRectangle = Rectangle2（insertionPoint， MyWidth + 70， MyHeight + 70）
Set textObj1 = textObj（“textstring”， insertionPoint， 100）
j = 0
yoffset = 0
Do until Sheets（“sheet1”）.单元格（19， 3 + j）.值 = 0
xoffset = 0
i = 0
Do 直到 Sheets（“sheet1”）。单元格（19 + i，3 + j）。值 = 0
插入点（0） = yoffset
插入点（1） = xoffset
MyHeight = Sheets（“sheet1”）。Cells（19 + i， 3 + j）
MyWidth = Sheets（“sheet1”）。Cells（19 + i， 4 + j）
Set MyRectangle = Rectangle2（insertionPoint， MyWidth， MyHeight）
Set textObj = ActiveDocument.ModelSpace.AddText（textstring， insertionPoint， height）' ------- problem
If Sheets（“Sheet1”）.Cells（19 + i， 5 + j） = “Open” 然后
Set MyRectangle = Rectangle1（insertionPoint， MyWidth， MyHeight）
End If

xoffset = xoffset + MyHeight
i = i - 2
Loop
yoffset = yoffset + MyWidth
j = j + 3
Loop
.
.
。
。
。
。

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

mmelone · 发表于 2016-5-10 16:11:08

乍一看，似乎从未在test_rectangle函数中定义高度。由于高度没有变暗，因此该变量将自动创建为变量。但是，由于变量从未被赋予值，因此当您试图将其传递到AddText函数时，它没有值。

Suresh_nair · 发表于 2016-5-10 21:27:33

mmelone感谢您的快速回复。
我尝试过
设置textObj = ActiveDocument。ModelSpace.AddText("textstring "，insertionPoint，100)
这里我假设插入点将从循环本身获得所需的值。
这也不起作用。

Suresh_nair · 发表于 2016-5-14 11:03:35

尝试使用：

copy

Dim insertionPoint(1) As Double

而不是

copy

Dim insertionPoint(1) As Variant

Roy_043 · 发表于 2016-5-15 03:50:47

需要一个3d点而不是2
Dim插入点（0到2）作为双=好

Bryco · 发表于 2016-5-15 11:34:47

Sub-txt_insert（）
将文本对象设置为AcadText
并将文本字符串设置为字符串
将插入点（0到2）设置为双
插入点（1）=-1000:insertionPoint（1）=200+张纸（“sheet1”）。单元（10，2）+片材（“片材1”）。单元格（34，2）/2：插入点（2）=0＜br＞设置textObj=ActiveDocument.ModelSpace。AddText（“俯视图”，插入点，140）
插入点（0）=-1500：插入点（1）=-Sheets（“sheet1”）。单元格（34，2）/2：插入点（2）=0＜br＞设置textObj=ActiveDocument.ModelSpace。AddText（“底部视图”，插入点，140）
插入点（0）=-1200：插入点（1）=-200-图纸（“图纸1”）。单元（34，2）-片材（“片材1”）。单元格（22，2）/2:insertionPoint（2）=0
设置textObj=ActiveDocument.ModelSpace。AddText（“后视图”，插入点，140）
结束子
我能够在循环之外工作，并将我的文本放到drg上。我的问题是，当我试图将文本写入循环时，我无法做到这一点。
另外，请查看随附的fie。我在框架视图（红色矩形）内绘制单个面板（蓝色矩形），以获得最佳匹配。我对这部分没意见。现在我想在循环运行时绘制矩形之后，在矩形本身中添加每个蓝色矩形的尺寸。

Roy_043 · 发表于 2016-5-15 16:24:32

对 xl 表的引用是否返回双精度值？您可能需要在代码中设置一个断点，并观察它是什么，以确保 InsertionPoint（1）设置正确。如果没有，您可能需要使用 CDbl（）函数将其显式转换为双精度值。

Suresh_nair · 发表于 2016-5-17 09:03:49

谢谢伙计们。问题已解决
公共函数textObj(textstring As String，insertionPoint As Double，height As Double)

Dim text obj As acad text
Dim text String As String
Dim insertion point(0到2)As Double
Dim height As Double
height = 100

insertion point(0)= 2:insertion point(1)= 2:insertion point(2)= 0
text = my height & " x " & my width

End Function
Sub test _ rectangle()
Dim insertion point(0到2)As Double
Dim MyWidth As Double
Dim MyHeight As Double
Dim MyRectangle As acadlw polyline
Dim I，j As Integer
Dim xoffset As Double
Dim text obj As acad text
'-FRONT

'调用ChnageAllToLyerCells(10，2)
MyWidth = Sheets("sheet1 ")。Cells(11，2)
Set MyRectangle = rectangle 3(insertion point，MyWidth，my height)
insertion point(0)=-35
insertion point(1)=-35
Set MyRectangle = rectangle 3(insertion point，MyWidth + 70，my height+70)
j = 0
yoffset = 0
Do unt Sheets(" sheet 1 ")。单元格(19，3 + j)。value = 0
xoffset = 0
I = 0
Do Until Sheets(" sheet 1 ")。细胞(19 + i，3 + j)。value = 0
insertion point(0)= yoffset
insertion point(1)= xoffset
my height = Sheets(" sheet 1 ")。Cells(19 + i，3 + j)
MyWidth = Sheets("sheet1 ")。Cells(19 + i，4+j)
Set MyRectangle = rectangle 2(insertion point，MyWidth，my height)
insertion point(1)= xoffset+50
Set text obj = active document。model space . add text(my width & " x " & my height，insertionPoint，100)

If Sheets("Sheet1 ")。Cells(19 + i，5 + j) = "Open "然后
Set MyRectangle = rectangle 1(insertion point，MyWidth，my height)
End If

xoffset = xoffset+my height
I = I-2
Loop
yoffset = yoffset+my width
j = j+3
Loop
' _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ TOP
insertion point(0)= 0
insertion point(1Cells(10，2)+70+100
my height = Sheets(" sheet 1 ")。Cells(34，2)
MyWidth = Sheets("sheet1 ")。Cells(35，2)
Set MyRectangle = rectangle 3(insertion point，MyWidth，my height)
insertion point(0)=-35
insertion point(1)=-35+sheet(" sheet 1 ")。Cells(10，2)+70+100
Set MyRectangle = rectangle 3(insertion point，MyWidth + 70，my height+70)
j = 0
yoffset = 0
直到工作表(" sheet1 ")为止。Cells(43，3+j)= 0 x offset = 0 I = 0直到工作表(“sheet1”)。Cells(43 + i，3+j)= 0
insertion point(0)= yoffset
insertion point(1)= xoffset+Sheets(" sheet 1 ")。Cells(10，2)+70+100
my height = Sheets(" sheet 1 ")。Cells(43 + i，3 + j)
MyWidth = Sheets("sheet1 ")。Cells(43 + i，4+j)
Set MyRectangle = rectangle 2(insertion point，MyWidth，my height)

insertion point(1)= xoffset+Sheets(" sheet 1 ")。Cells(10，2) + 70 + 100 + 50设置textObj = ActiveDocument。model space . add text(my width & " x " & my height，insertionPoint，100)

If Sheets("Sheet1 ")。Cells(43 + i，5 + j) = "Open "然后
Set MyRectangle = rectangle 1(insertion point，MyWidth，my height)
End If

xoffset = xoffset+my height
I = I-2
Loop
yoffset = yoffset+my width
j = j+3
Loop
附件供参考。现在开始美化部分..
问题确实是插入点定义错误
感谢57gmc/roy_043/mmelone & bryco的回复和帮助。干杯。
我需要关闭这篇文章或将其标记为已解决吗？请指教。再次感谢伙计们。

循环时无法在autocad中添加文本。

发表回复

精选推荐