我面临VBA代码的问题，

Elias · 发表于 2022-7-6 21:10:06

子XYZ（）
将ttt1设置为字符串
将ttt2设置为字符串
Dim ttt3作为字符串
Dim ccoc作为整数
尺寸P1（0到2）为双精度
尺寸t1作为变型
变光t2
Dim总计（0到5）为双精度
Dim t、sel、myBlock、po、ac、b1、b2、xl作为对象
Dim p作为变型
尺寸p2（0到2）为双精度
Dim-tex、i、ch、c、g、r、tp、en、co、rn
出错时继续下一步
设置ac=GetObject（，“AutoCAD.Application”）：设置xl=GetObject（，“Excel.Application”）
如果错误为0，则MsgBox“请您首先打开AutoCAD：（”：退出Sub
xl。窗口状态=xl最小化
ac.WindowState=vbMaximizedFocus
出错时继续下一步：ac.ActiveDocument。选择集（“TempSSet”）。删去
设置sel=ac.ActiveDocument。选择集。添加（“临时设置”）
选择。在屏幕上选择
i=-1：单元格（0，1）=“SNo”：单元格（1，2）=“东距”：单元格（1，3）=“北距”：单元格（1，4）=“高程”：单元格（1，5）=“对象名称”：单元格（1，6）=“长度”：单元格（1，7）=“半径”：单元格（1，8）=“面积”
对于sel中的每个po
tp=tp+1
下一个
co=2
rn=3
如果第62页。复选框1。值=False或Sheet62。复选框2。值=False，然后是xl。窗口状态=xl最大化
对于sel中的每个po
如果co=8，则co=2，否则co=co+1
i=i+1
如果i>tp-1，则退出
设置myBlock=sel。项目（i）
如果InStr（1，myBlock.ObjectName，“Text”，vbTextCompare）=False，InStr（1，myBlock.ObjectName，“Leader”，vbTextCompare）=False，InStr（1，myBlock.ObjectName，“Dimension”，vbTextCompare）=False，则
如果是myBlock。ObjectName=“AcDbLine”或myBlock。ObjectName=“AcDbArc”然后
t1=myBlock。起止点
t2=myBlock。端点
总计（0）=t1（0）：总计（1）=t1（1）：总计（2）=t1（2）：总计（3）=t2（0）：总计（4）=t2（1）：总计（5）=t2（2）
p=总计
其他的
p=myBlock。协调
如果结束
如果是myBlock。ObjectName=“AcDbCircle”然后
p=myBlock。居中
如果结束
出错时继续下一步
对于g=0到100000
犯错误清楚的
ch=p（g）
如果错误为0，则退出
下一个
g=g-1
如果是myBlock。ObjectName=“AcDbPolyline”或myBlock。ObjectName=“AcDbSpline”则r=2，否则r=3
en=0
对于c=0到g，步骤r
P1（0）=p（c）：P1（1）=p（c+1）
如果r=3，则P1（2）=p（c+2）
jeenee=我的街区。对象名称
如果左（jeenee，4）=“AcDb”，则jeenee=ExtractElement（jeenee，2，“AcDb”）
对于nee=1到rn-1
If单元（nee，2）。值=P1（0）和单元格（nee，3）。值=P1（1），然后退出
下一个
p2（0）=P1（0）+表62。文本框2。文本：p2（1）=P1（1）+表62。文本框3。文本：p2（2）=0：单元格（rn，2）=rn-1：单元格（rn，3）=P1（0）：单元格（rn，4）=P1（1）：单元格（rn，5）=P1（2）：单元格（rn，6）=jeenee
tex=“”
ccoc=第62页。文本框4.Text
ttt1=圆形（P1（0），ccoc）
ttt1=Cunt（ttt1，ccoc）
ttt2=圆形（P1（1），ccoc）
ttt2=Cunt（ttt2，ccoc）
ttt3=圆形（P1（2），ccoc）
ttt3=Cunt（ttt3，ccoc）
如果第62页。复选框1.Value=True，然后tex=“X=”&ttt1&Chr（10）&“Y=”&ttt2&Chr（10）&“Z=”&ttt3&Chr（10）
如果第62页。复选框2.Value=True，然后tex=“P.”&rn-1&Chr（10）&tex
如果第62页。复选框6。值=True，然后tex=rn-1&Chr（10）&tex
如果nee=rn和（Sheet62.CheckBox1.Value=True或Sheet62.CheckBox2.Value=True或Sheet62.CheckBox6.Value=True），则设置t=ac.ActiveDocument。模型空间。AddMText（p2，0，tex）：t。高度=表62。文本框1.Text:t.更新
en=en+1
rn=rn+1
下一个
'如果是myBlock。层=“”然后单元格（1，8）=0其他
如果是myBlock。ObjectName=“AcDbLine”或myBlock。ObjectName=“AcDbPolyline”然后单元格（rn-1，7）=圆形（myBlock.Length，4）
如果是myBlock。ObjectName=“AcDbLine”或myBlock。ObjectName=“AcDbPolyline”然后单元格（rn-1，9）=圆形（myBlock.Area，4）
如果是myBlock。ObjectName=“AcDbCircle”或myBlock。ObjectName=“AcDbArc”然后是单元格（rn-1，8。）=圆形（myBlock.Radius，4）
如果是myBlock。ObjectName=“AcDbCircle”或myBlock。ObjectName=“AcDbArc”然后单元格（rn-1，9）=圆形（myBlock.Area，4）
如果结束
下一个
列（“A:I”）。整个过程。自动调整
列（“J:I”）。字体。Bold=True
范围（“A1:I1”）。字体。Bold=True
范围（“A1:I1”）。水平对齐=xlCenter

末端接头

rlx · 发表于 2022-7-6 21:20:41

这个网站有一个特别的vba论坛，我想你应该在那里发布。我几乎没有vba的经验，所以我要做一个大胆的猜测：

copy


i = -1: Cells(0, 1) = "SNo.": Cells(1, 2) = "EASTING": Cells(1, 3) = "NORTHING": Cells(1, 4) = "ELEVATION": Cells(1, 5) = "Object Name": Cells(1, 6) = "Length": Cells(1, 7) = "Radius":

我假设I=-1是一个计数器，您可能会使用。。。bladiebla（集合i（i+1））。。。在某个时刻。在lisp中，列表中的第一项是数字0，但是，在这里猜测一下，vba/excel可能以1开头？我的autocad中没有启用vba，因此无法测试它。我确信这里的其他用户也使用vba，我相信比格尔对vba有一定的经验，他回答了这个论坛上发布的许多问题，所以我不会惊讶他会给你一个（更好的）答案。

BIGAL · 发表于 2022-7-6 21:29:39

我所知道的VBa是危险的，一些缺少测试的东西可能是细胞（rn，2）=rn-1 rn-2？

Elias · 发表于 2022-7-6 21:35:58

你好，亲爱的比格尔，

你能更具体地说一下缺少什么吗
当我把rn=2放在第二排时，它从1开始编号，所以我需要它从第三排开始编号（1），我很累，但我仍然不知道是什么错误。
谢谢

BIGAL · 发表于 2022-7-6 21:38:21

如果你写了代码，那么你应该能够找出什么是错的，或者是其他人做的？看起来正在调用某些表单。

好啊
我需要图像显示出问题所在。
2需要包含宏的xls。

再说一次，我不是VBA方面的专家。

Elias · 发表于 2022-7-6 21:47:55

对不起打扰你了

BIGAL · 发表于 2022-7-6 21:55:11

正如我已经猜到的，看看你的行号，你有一行作为一个空行，所以第3-2行如果想要一个1。这是一个找到rn-2位置的例子。不确定为什么第1行为空，但这可能更难解决。可以测试A1空白A2空白等，并减去正确的行号。

我认为是在这一行
p2（0）=P1（0）+表62。文本框2。文本：p2（1）=P1（1）+表62。文本框3.Text:p2（2）=0：单元格（rn，2）=rn-1：单元格（rn，3）=P1（0）：单元格（rn，4）=P1（1）：单元格（rn，5）=P1（2）：

目前未测试忙

sanju2323 · 发表于 2022-7-6 22:00:14

嗨，Elias，

您需要更改以下几行，希望您的问题得到解决。

copy


'Replace line
If Sheet1.CheckBox2.Value = True Then tex = "P. " & rn - 1 & Chr(10) & tex
If Sheet1.CheckBox6.Value = True Then tex = rn - 1 & Chr(10) & tex
'with
If Sheet1.CheckBox2.Value = True Then tex = "P. " & rn - 2 & Chr(10) & tex
If Sheet1.CheckBox6.Value = True Then tex = rn - 2 & Chr(10) & tex

copy


'Replace line
p2(0) = P1(0) + Sheet1.TextBox2.Text: p2(1) = P1(1) + Sheet1.TextBox3.Text: p2(2) = 0: Cells(rn, 2) = rn - 1: Cells(rn, 3) = P1(0): Cells(rn, 4) = P1(1): Cells(rn, 5) = P1(2): Cells(rn, 6) = jeenee
'with
p2(0) = P1(0) + Sheet1.TextBox2.Text: p2(1) = P1(1) + Sheet1.TextBox3.Text: p2(2) = 0: Cells(rn, 2) = rn - 2: Cells(rn, 3) = P1(0): Cells(rn, 4) = P1(1): Cells(rn, 5) = P1(2): Cells(rn, 6) = jeenee

再见