数据导出

Kalsefar · 发表于 2022-7-6 20:55:10

每次我将数据从Excel导出到AutoCAD时都会面临同样的问题，AutoCAD是一个导出到位置X:0.00，Y:0.00，Z:0.00的点，我不知道为什么它会导出该位置的点？！
谁能帮帮我吗？

请参阅随附的图片，以使其更清晰
谢谢

SLW210 · 发表于 2022-7-6 21:02:15

你的代码是什么？

Dadgad · 发表于 2022-7-6 21:05:21

我认为，这将是模型空间中的默认原点。
永远不要这样做，所以没有具体的经验。

Kalsefar · 发表于 2022-7-6 21:12:31

@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）
如果结束
末端接头