021集——批量txt格式坐标转dwg——vba代码实现

最新推荐文章于 2025-07-08 09:56:35 发布

原创最新推荐文章于 2025-07-08 09:56:35 发布 · 957 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#CAD

CAD VBA 专栏收录该内容

77 篇文章

订阅专栏

在工作中遇到txt转dwg的重复性工作，详细如下：

已知若干个txt文件，坐标格式如下：

要求：将每个txt格式坐标文件转为dwg，名称与原txt名称一样，即1.txt生成1.dwg。

因txt文件中存在一些非坐标文本数字，我们需进行判断只提取xy坐标数据，然后在cad中输入坐标，生成一个轻量线。

此项工作只需一个dvb文件即可搞定。

使用方法：在cad任务栏输入 "vbaman"，加载此dvb文件，然后输入"vbarun",运行此程序，选择文件夹，即可在同一文件夹中自动生成同名dwg文件，详情可qq443440204

另附部分源代码如下：

Sub txt_to_dwg2004()
'yngqq:443440204@2024年7月15日15:52:08
On Error Resume Next
Dim ent As AcadEntity
Dim filepath As String, ljwj As String, count As Integer, filefullname As String
Dim fileNO As Integer, inputline As String, firstCommaPosition As Integer, secondCommaPosition As Integer
Dim temp1() As String, temp2 As String, temp_arr() As String
filepath = GOFOLDER
ljwj = Dir(filepath & "\*.txt")
Do While ljwj <> "" 
''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
''''''
''''''
''''''     详情qq:443440204
''''''
''''''
''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''

   Loop
    Close #fileNO
    Documents.Add
    Set ent = ThisDrawing.ModelSpace.AddLightWeightPolyline(zb)
    ent.Closed = True
    ZoomExtents
    'ThisDrawing.Regen acAllViewports
    ThisDrawing.SaveAs Left(filefullname, Len(filefullname) - 4) & ".dwg", ac2004_dwg
    ThisDrawing.Close
    Erase zb
    ljwj = Dir
Loop
MsgBox "已完成!" & vbCr & "qq:443440204", , "版权所有qq:443440204"
End Sub