数据导出，需要帮助吗

Kalsefar · 发表于 2022-7-6 20:15:09

[颜色=202020][大小=14px]每次我将数据从Excel导出到AutoCAD时，我都会面临相同的问题，这是一个导出到位置X:0.00，Y:0.00，Z:0.00的点，我不知道为什么它会导出该位置的点？！
有人能帮我吗？

这是代码：
[颜色=#202020][大小=14px]\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\________________________________
私有子命令按钮1\u Click（）
TextHeight=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”
出口接头
结束If
'******************************************************************************************************************************************************************************************************************************************8
如果复选框5。值=True Then
作为字符串的Dim strLayerName1、strLayerName2、strLayerName3、strLayerName4
将objLayer1、objLayer2、objLayer3、objLayer4作为对象[color]
strLayerName1=TextBox33。文本
如果“=strLayerName1，则退出Sub”如果未输入名称，则退出[/size
On Error Resume Next“处理内联异常”
'检查层是否已存在
设置objLayer1=acadObj。ActiveDocument。层（strLayerName1）
如果objLayer1为空，则
设置objLayer1=acadObj。ActiveDocument。层。添加（strLayerName1）
如果objLayer1为Nothing，则“检查是否已设置obj”
lyt=“'”&strLayerName1&“'”&vbNewLine
其他
'MsgBox“添加了层'”&objLayer。名称&“'”
如果结束
其他
“MsgBox”层已存在”
如果结束
'************************************************************
strLayerName2=文本框34。文本
“If”“=strLayerName2 Then Exit Sub”如果未输入名称，则退出
On Error Resume Next“处理内联异常”
'检查层是否已存在
设置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 As Object
Set 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”如果没有输入名称，则退出[/size
On Error Resume Next“处理内联异常”
'检查层是否已存在
设置objLayer5=acadObj。ActiveDocument。层（strLayerName5）
'如果objLayer5什么都不是，那么
设置objLayer5=acadObj。ActiveDocument。层。添加（strlayername 5）
如果objLayer5为Nothing，则“检查是否已设置obj”
lyt=“'”&strLayerName5&“'”&vbNewLine
其他
'MsgBox“添加了层'”&objLayer。名称&“'”
如果结束
'其他
“MsgBox”层已存在”
'如果结束
结束If
'*********************************************************
家伙：
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）
结束If
End Sub

PeterPan9720 · 发表于 2022-7-6 21:01:47

你好@Kalsefar
如果要求在Autocad区域上从0,0开始绘制一条线，会发生什么行为？你试过了吗？只是为了检查你的0,0坐标在哪里。
您可以在运行代码之前执行此操作，以了解问题是在图形上还是在代码中。
读取代码Autocad可以在运行excel过程之前或之后打开，因此您可以打开Autocad、新图形（或现有图形，如果需要）并从0,0坐标追踪直线。
你的代码太复杂了，只有你知道最终的作用域是什么。
让我们知道

goran · 发表于 2022-7-6 21:15:45

copy


Dim qst
    Dim acadObj As Object
    Dim ExcelObj As Object
        On Error Resume Next
    Set acadObj = GetObject(, "AutoCAD.Application")
    If acadObj Is Nothing Then
    qst = MsgBox("AutoCAD Is Not Open. DoYou Want To Open AutoCAD With A New Drawing?", vbYesNo)
    If qst <> vbYes Then Exit Sub

。。。。。。。
然后再次：

copy


 Dim objLayer5 As Object
    Set ExcelObj = GetObject(, "Excel.Application")
    Set acadObj = GetObject(, "AutoCAD.Application")
    ExcelObj.WindowState = xlMinimized
    acadObj.WindowState = vbMaximizedFocus

[颜色=202020]
从哪里运行此代码，从Ecel或Autocad？
您可以在代码中输入断点，在Dick中尝试：（）位置，检查范围（“START\u 1”）。偏移量（i，0）。值返回。
另一件事，附上Excel文件，所以如果有人想尝试你的代码。。。

最后
再次强调同样的价值，这很慢。首先从excel中循环，收集所有数据，然后通过数组循环（在.Net中，对于lwpolylines有Point3dCollection[]或Point2dCollection）。

[编程交流] 数据导出，需要帮助吗

发表回复

精选推荐