VBA读取文件

mien · 发表于 2022-7-6 14:45:54

有人能帮我写这个代码吗。此代码在读取文件时停止。。。它认为这是一个逻辑错误，但我不能解决它。。。谢谢


Public Sub Plot_Click()
Me.Hide
Dim strFileName As String
Dim myFile As Integer
Dim strTextLine As String
Dim arrText As Variant
Dim dblX As Variant
Dim dblY As Variant
Dim dblZ As Variant
strFileName = mstrinpfile
   
   If Dir(strFileName) = "" Then
   Call MsgBox(strFileName & " not found", vbExclamation, "Import XYZ Coordinates")
   
   End If
   
'add parameter
ThisDrawing.SendCommand "PDMODE" & vbCr
ThisDrawing.SendCommand "0" & vbCr
ThisDrawing.SendCommand "PDsize" & vbCr
ThisDrawing.SendCommand "0" & vbCr
ThisDrawing.SendCommand "CMDECHO" & vbCr
ThisDrawing.SendCommand "0" & vbCr
ThisDrawing.SendCommand "-Style" & vbCr
ThisDrawing.SendCommand "WMH" & vbCr
ThisDrawing.SendCommand "Romans" & vbCr
ThisDrawing.SendCommand "0" & vbCr
ThisDrawing.SendCommand "0.75" & vbCr
ThisDrawing.SendCommand "15" & vbCr
ThisDrawing.SendCommand "N" & vbCr
ThisDrawing.SendCommand "N" & vbCr
ThisDrawing.SendCommand "N" & vbCr
ThisDrawing.SendCommand "-Units" & vbCr
ThisDrawing.SendCommand "2" & vbCr
ThisDrawing.SendCommand "3" & vbCr
ThisDrawing.SendCommand "2" & vbCr
ThisDrawing.SendCommand "4" & vbCr
ThisDrawing.SendCommand "90" & vbCr
ThisDrawing.SendCommand "Y" & vbCr
ThisDrawing.SendCommand "-Layer" & vbCr
ThisDrawing.SendCommand "Make" & vbCr
ThisDrawing.SendCommand "WMH_PDEPTH" & vbCr
myFile = FreeFile
Open mstrinpfile For Input As #myFile
   Do While Not EOF(myFile)
   Line Input #myFile, strTextLine
   arrText = Split(strTextLine, ",")
   
   dblX = arrText(0)
   dblY = arrText(1)
   dblZ = arrText(2)
    
            
If (Val(dblZ) >= Val(mintlv1)) Then
ThisDrawing.SendCommand "-color" & vbCr
ThisDrawing.SendCommand "BYLAYER" & vbCr
ThisDrawing.SendCommand "point" & vbCr
ThisDrawing.SendCommand dblY & "," & dblX & "," & dblZ & vbCr
ThisDrawing.SendCommand "-Layer" & vbCr
ThisDrawing.SendCommand "Make" & vbCr
ThisDrawing.SendCommand "WMH_BDEPTH" & vbCr
ThisDrawing.SendCommand "" & vbCr
ThisDrawing.SendCommand "-color" & vbCr
ThisDrawing.SendCommand Val(cl1) & vbCr
ThisDrawing.SendCommand "-Text" & vbCr
ThisDrawing.SendCommand "R" & vbCr
ThisDrawing.SendCommand dblY & "," & dblX & "," & dblZ & vbCr
ThisDrawing.SendCommand "2.0" & vbCr
ThisDrawing.SendCommand "90" & vbCr
ThisDrawing.SendCommand Left(dblZ, 2) & vbCr
ThisDrawing.SendCommand "-Layer" & vbCr
ThisDrawing.SendCommand "Make" & vbCr
ThisDrawing.SendCommand "WMH_SDEPTH" & vbCr
ThisDrawing.SendCommand "" & vbCr
ThisDrawing.SendCommand "-Text" & vbCr
ThisDrawing.SendCommand "ML" & vbCr
ThisDrawing.SendCommand dblY & "," & dblX & "," & dblZ & vbCr
ThisDrawing.SendCommand "1.5" & vbCr
ThisDrawing.SendCommand "90" & vbCr
ThisDrawing.SendCommand Right(dblZ, 1) & vbCr
ThisDrawing.SendCommand "zoom" & vbCr
ThisDrawing.SendCommand "extents" & vbCr
ElseIf (Val(dblZ) >= Val(mintlv2)) Then
ThisDrawing.SendCommand "-color" & vbCr
ThisDrawing.SendCommand "BYLAYER" & vbCr
ThisDrawing.SendCommand "point" & vbCr
ThisDrawing.SendCommand dblY & "," & dblX & "," & dblZ & vbCr
ThisDrawing.SendCommand "-Layer" & vbCr
ThisDrawing.SendCommand "Make" & vbCr
ThisDrawing.SendCommand "WMH_BDEPTH" & vbCr
ThisDrawing.SendCommand "" & vbCr
ThisDrawing.SendCommand "-color" & vbCr
ThisDrawing.SendCommand Val(cl1) & vbCr
ThisDrawing.SendCommand "-Text" & vbCr
ThisDrawing.SendCommand "R" & vbCr
ThisDrawing.SendCommand dblY & "," & dblX & "," & dblZ & vbCr
ThisDrawing.SendCommand "2.0" & vbCr
ThisDrawing.SendCommand "90" & vbCr
ThisDrawing.SendCommand Left(dblZ, 2) & vbCr
ThisDrawing.SendCommand "-Layer" & vbCr
ThisDrawing.SendCommand "Make" & vbCr
ThisDrawing.SendCommand "WMH_SDEPTH" & vbCr
ThisDrawing.SendCommand "" & vbCr
ThisDrawing.SendCommand "-Text" & vbCr
ThisDrawing.SendCommand "ML" & vbCr
ThisDrawing.SendCommand dblY & "," & dblX & "," & dblZ & vbCr
ThisDrawing.SendCommand "1.5" & vbCr
ThisDrawing.SendCommand "90" & vbCr
ThisDrawing.SendCommand Right(dblZ, 1) & vbCr
ThisDrawing.SendCommand "zoom" & vbCr
ThisDrawing.SendCommand "extents" & vbCr
Else
MsgBox "Error!!!!! Fail to Plot", 48, "HydroLab"
End
End If
Loop
ThisDrawing.SendCommand "zoom" & vbCr
ThisDrawing.SendCommand "extents" & vbCr
Close #myFile 'close file
MsgBox "Plot Coordinates Completed"
Me.Show
End Sub

CmdrDuh · 发表于 2022-7-6 14:50:51

首先，我会去掉所有那些send命令，因为这可能就是问题所在。Send命令不会等到Autocad完成其操作后再继续下一步，因此您可能不同步

mien · 发表于 2022-7-6 14:59:00

我已经试过了，但它不起作用。。。你能帮我做这个吗。。

CmdrDuh · 发表于 2022-7-6 15:02:41

从这张图开始。SetVariable设置变量

mien · 发表于 2022-7-6 15:08:49

谢谢你。。。。

CmdrDuh · 发表于 2022-7-6 15:09:50

我看到的另一个错误是它看起来不像lilke，你在这里以外的地方声明了你的文件

copy

strFileName = mstrinpfile

mien · 发表于 2022-7-6 15:16:20

我已经在下面声明了option explicit。。但它似乎不执行if。。。如果没有控制结构，我如何克服这个问题。。谢谢

SEANT · 发表于 2022-7-6 15:19:48

这是一种使用VBA与图形数据库直接交互的方法。

警告：该示例进行了修改，仅处理您的一部分流程需求。您必须将例程修改为所需的规格。

如CmdrDuh所述，调查该图纸。SetVariable，

如果您对这些修改有任何问题，请与我们联系。

[code]选项明确约束pi为Double=3.14159265子命令按钮20\u Click（）Dim strFileName为StringDim myFile为IntegerDim outfile为StringDim strTextLine为StringDim arrText为VariantDim point为AcadPointDim cllyr为AcadLayerDim strName为StringDim acText为AcadTextDim dblPt（2）为DoubleDim mintlv1为DoubleDim mintlv2为DoubleDim strTemp为Stringmintlv1=-8#'tempassignmentmintlv2=-10#'临时assignmentSet cllyr=ThisDrawing。层。添加（“WMH_PDEPTH”）cllyr。color=acGreenSet cllyr=ThisDrawing。层。添加（“WMH_BDEPTH”）cllyr。color=acBlueSet cllyr=ThisDrawing。层。添加（“WMH_SDEPTH”）cllyr。颜色=与此图纸一致。实用程序strFileName=“C:\Hydro.txt”'temp assignment'On Error GoTo ErrorHandlerPoint If Dir（strFileName）=“”，然后调用MsgBox（strFileName&“not found”，vb惊叹，“Import XYZ Coordinates”）退出Sub'GoTo TidyUpAndExit End If myFile=FreeFile打开strFileName作为输入#myFile Do，而不是EOF（myFile）行输入#myFile，strTextLine arrText=Split（strTextLine，“，”）dblPt（0）=。DistanceToReal（arrText（0），acDecimal）dblPt（1）=。DistanceToReal（arrText（1），acDecimal）dblPt（2）=。DistanceToReal（arrText（2），acDecimal）选择Case dblPt（2）Case Is mintlv2 Set point=此图形。模型空间。添加点（dblPt）点。Layer=“WMH\u PDEPTH”strTemp=Left（arrText（2），2）设置acText=ThisDrawing。模型空间。AddText（左（arrText（2），2），dblPt，2#）acText。对齐=acAlignmentRight acText。旋转=pi/2 acText。Layer=“WMH\u BDEPTH”acText。text对齐点=dblPt acText。更新strTemp=Right（arrText（2），2）设置acText=ThisDrawing。模型空间。AddText（右（arrText（2），2），dblPt，1.5）acText。对齐=ACAlignmentMiddleft acText。旋转=pi/2 acText。Layer=“WMH\U SDEPTH”acText。text对齐点=dblPt acText。更新案例为

mien · 发表于 2022-7-6 15:26:51

我试着根据颜色对图层进行分类。。。我做了修改，但不起作用。
[code]公共子图_单击（）我。HideDim strFileName As StringDim myFile As IntegerDim strTextLine As StringDim dblX As DoubleDim dblY As DoubleDim dblZ As DoubleDim arrText As VariantDim point As AcadPointDim cllyr As AcadLayerDim strName As StringDim acText As AcadTextDim dblPt（0到2）As DoubleDim strTemp As StringWith this drawing。UtilitystrFileName=mstrinpfile“On Error GoTo ErrorHandlerPoint If Dir（strFileName）=”然后调用MsgBox（strFileName&“not found”，vb惊叹，“Import XYZ Coordinates”）'GoTo TidyUpAndExit End IfmyFile=freefile打开strFileName作为输入#myFile Do，而不是EOF（myFile）行输入#myFile，strextline arrText=Split（strextline，“，”）dblPt（0）=。DistanceToReal（arrText（0），acDecimal）dblPt（1）=。DistanceToReal（arrText（1），acDecimal）dblPt（2）=。DistanceToReal（arrText（2），acDecimal）选择Case dblPt（2）Case Is

hontis · 发表于 2022-7-6 15:28:01

在哪里可以学习VB

[编程交流] VBA读取文件

发表回复

精选推荐