数据导出
每次我将数据从Excel导出到AutoCAD时都会面临同样的问题,AutoCAD是一个导出到位置X:0.00,Y:0.00,Z:0.00的点,我不知道为什么它会导出该位置的点?!谁能帮帮我吗?
请参阅随附的图片,以使其更清晰
谢谢
你的代码是什么? 我认为,这将是模型空间中的默认原点。
永远不要这样做,所以没有具体的经验。 @SLW210
先生
我附上Excel文件有代码
这是代码:
_______________________________________________________________________________________________________
私有子命令按钮1\u Click()
text高度=TextBox30。文本
如果IsNumeric(TextHeight)=False或TextHeight=0,则TextHeight=0.25
DeltaX=文本框31。文本
DeltaY=文本框32。文本
Dim qst
Dim acadObj作为对象
Dim ExcelObj作为对象
出错时继续下一步
设置acadObj=GetObject(,“AutoCAD.Application”)
如果acadObj什么都不是那么
qst=MsgBox(“AutoCAD未打开。是否要用新图形打开AutoCAD?”,vbYesNo)
如果qst vbYes,则退出Sub
设置acadObj=CreateObject(“AutoCAD.Application”)
单元格(2,9)=“”
命令6。可见=真
命令7。可见=真
如果结束
如果acadObj什么都不是那么
MsgBox“您的计算机中没有AutoCad软件。”&“对不起,没有AutoCad,您无法使用此程序。”&vbNewLine&“如果您确定计算机中有AutoCAD,请检查在AutoCAD中启用的VBA。”,vbCritical,“CSV到AUTOCAD”
出口接头
如果结束
'**************************************************************8
如果复选框5。值=True Then
作为字符串的Dim strLayerName1、strLayerName2、strLayerName3、strLayerName4
对象为Dim objLayer1、objLayer2、objLayer3、objLayer4
strLayerName1=文本框33。文本
如果“=strLayerName1,则退出Sub”如果未输入名称,则退出
出错时恢复下一个“内联处理异常”
'检查层是否已存在
设置objLayer1=acadObj。ActiveDocument。层(strLayerName1)
如果objLayer1为Nothing,则
设置objLayer1=acadObj。ActiveDocument。层。添加(strLayerName1)
如果objLayer1为Nothing,则“检查是否已设置obj”
lyt=“'”&strLayerName1&“'”&vbNewLine
其他
'MsgBox“添加了层'”&objLayer。名称&“'”
如果结束
其他
“MsgBox”层已存在”
如果结束
'************************************************************
strLayerName2=文本框34。文本
“If”“=strLayerName2 Then Exit Sub”如果未输入名称,则退出
出错时恢复下一个“内联处理异常”
'检查层是否已存在
设置objLayer2=acadObj。ActiveDocument。层(strLayerName2)
如果objLayer2什么都不是
设置objLayer2=acadObj。ActiveDocument。层。添加(strLayerName2)
如果objLayer2为Nothing,则“检查是否已设置obj”
lyt=lyt&“'”&strLayerName2&“'”&vbNewLine
其他
“MsgBox”添加了Layer Layer“&objLayer。名称&“'”
如果结束
其他
“MsgBox”层已存在”
如果结束
如果结束
'******************************************************************
Dim basePnt(0到2)为双精度
Dim insertPnt(0到2)作为双精度
Dim strLayerName5作为字符串
Dim objLayer5作为对象
设置ExcelObj=GetObject(,“Excel.Application”)
设置acadObj=GetObject(,“AutoCAD.Application”)
ExcelObj。窗口状态=xl最小化
阿卡多布。WindowsState=vbMaximizedFocus
Do公司
i=i+1
If范围(“START_1”)。偏移量(i,0)。值“x”和范围(“START_1”)。偏移量(i,0)。值“X”,然后
'************************************************
如果复选框7。值=True Then
objLayer5=空
strLayerName5=范围(“START_1”)。偏移量(i,4)。文本
如果“=strlayername 5,则转到Dick”如果没有输入名称,则退出
出错时恢复下一个“内联处理异常”
'检查层是否已存在
设置objLayer5=acadObj。ActiveDocument。层(strLayerName5)
'如果objLayer5什么都不是,那么
设置objLayer5=acadObj。ActiveDocument。层。添加(strlayername 5)
如果objLayer5为Nothing,则“检查是否已设置obj”
lyt=“'”&strLayerName5&“'”&vbNewLine
其他
'MsgBox“添加了层'”&objLayer。名称&“'”
如果结束
'其他
“MsgBox”层已存在”
'如果结束
如果结束
'*********************************************************
家伙:
basePnt(0)=范围(“START_1”)。偏移量(i,0)。价值
basePnt(1)=范围(“START_1”)。偏移量(i,1)。价值
basePnt(2)=范围(“START_1”)。偏移量(i,2)。价值
如果文本框33。Enabled=True,然后是acadObj。ActiveDocument。ActiveLayer=acadObj。ActiveDocument。层(strLayerName1)
如果复选框7。值=True Then
如果“strLayerName5”,则为acadObj。ActiveDocument。ActiveLayer=acadObj。ActiveDocument。层(strLayerName5)
其他
如果文本框34。Enabled=False,然后是acadObj。ActiveDocument。ActiveLayer=acadObj。ActiveDocument。层(“0”)
如果结束
pointObj=无
设置pointObj=acadObj。ActiveDocument。模型空间。添加点(basePnt)
如果pointObj为Nothing,则MsgBox(“AutoCAD未响应”):退出Sub
insertPnt(0)=basePnt(0)+DeltaX
insertPnt(1)=basePnt(1)+DeltaY
插入PNT(2)=0
如果pointObj什么都不是,那么acadObj。WindowsState=vbMinimizedFocus:ExcelObj。WindowsState=xlMaximized:MsgBox“抱歉,AutoCad应用程序没有响应。”,vbCritical公司
'设置pointText=acadObj。ActiveDocument。模型空间。AddText(范围(“START_1”)。偏移量(i,-1)。值,插入PNT,文本高度)
如果文本框34。Enabled=True,然后是acadObj。ActiveDocument。ActiveLayer=acadObj。ActiveDocument。层(strLayerName2)
如果复选框30。值=True,然后TEXT\u点=范围(“START\u 1”)。偏移量(i,-1)。值和Chr(10)
如果选中复选框31。值=True,然后TEXT\u点=TEXT\u点和“X=”&basePnt(0)&Chr(10)
如果选中复选框32。值=True,然后TEXT\u点=TEXT\u点&“Y=”&basePnt(1)&Chr(10)
如果选中复选框33。值=True,然后TEXT\u点=TEXT\u点&“Z=”&basePnt(2)
设置pointText=acadObj。ActiveDocument。模型空间。AddMText(插入pnt,0,TEXT\u点)
点文本。高度=文本高度
TEXT_POINT=“”
pointObj。颜色=范围(“START_1”)。偏移量(i,3)。价值
如果结束
循环直到范围(“START_1”)。偏移量(i,0)。值=“”
“ExcelObj。窗口状态=xl最大化
“阿卡多布。WindowsState=vbMinimizedFocus
Dim jj公司
jj=(i*3)-1
Dim dblVertices()为双精度
ReDim dblVertices(jj)
如果选中复选框34。值=True Then
“阿卡多布。Activedocument。ActiveLayer=acadObj。Activedocument。层(strLayerName4)
'Dim COUNT,CO为整数
co=0
对于计数=1到i
dblVertices(co)=范围(“START_1”)。偏移量(计数,0)。价值
co=co+1
dblVertices(co)=范围(“START_1”)。偏移量(计数,1)。价值
co=co+1
dblVertices(co)=范围(“START_1”)。偏移量(计数,2)。价值
co=co+1
下一次计数
设置objEnt=acadObj。ActiveDocument。模型空间。Add3DPoly(dblVertices)
如果结束
末端接头 我的VBA有限,但看起来范围(“START_1”)从第2行开始,而不是第3行。 @比加尔
不,我试过了,还是有同样的问题 试着联系@sanju2323先生,他对VBA很了解。 在Autodesk论坛上查看我的答案,在任何情况下,您是否尝试从手动而不是指针确定的坐标0,0中跟踪一条线?只是为了了解你的程序是否真的指向0,0坐标。 @PeterPan9720我在Autodesk论坛上找不到您的答案,请附加链接好吗 可能是我弄糊涂了,无论如何,你有没有试着从坐标0,0中找出一条线,用手而不是指针?只是为了了解你的程序是否真的指向0,0坐标。
页:
[1]
2