我面临VBA代码的问题,
子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
末端接头 这个网站有一个特别的vba论坛,我想你应该在那里发布。我几乎没有vba的经验,所以我要做一个大胆的猜测:
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有一定的经验,他回答了这个论坛上发布的许多问题,所以我不会惊讶他会给你一个(更好的)答案。
我所知道的VBa是危险的,一些缺少测试的东西可能是细胞(rn,2)=rn-1 rn-2? 你好,亲爱的比格尔,
你能更具体地说一下缺少什么吗
当我把rn=2放在第二排时,它从1开始编号,所以我需要它从第三排开始编号(1),我很累,但我仍然不知道是什么错误。
谢谢 如果你写了代码,那么你应该能够找出什么是错的,或者是其他人做的?看起来正在调用某些表单。
好啊
我需要图像显示出问题所在。
2需要包含宏的xls。
再说一次,我不是VBA方面的专家。 对不起打扰你了
正如我已经猜到的,看看你的行号,你有一行作为一个空行,所以第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):
目前未测试忙 嗨,Elias,
您需要更改以下几行,希望您的问题得到解决。
'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
'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
再见 你的解决方案很有帮助,真的,兄弟,你是个天才
谢谢 欢迎光临
页:
[1]