VB。Net代码来读取CSV点
该代码将读取CSV点文件,例如空间分析仪(SA软件)将从某些项目、产品或竣工条件的激光扫描中输出什么。然后可以将这些数据读入AutoCAD(在本例中),以查看和创建扫描的点数据。我提供了一个包含49个点的示例CSV文本文件,但我使用此代码读取了20000多个点。' File Name: ReadPointsFromSA
'Description: Read a CSV point file from SpatialAnalyzer (SA)
' By: Robert Souza
' Contact info: dreamtoneampsgmail.com
' Date: June 25, 2010
Option Strict On
Imports System.IO
Imports System.Windows
Imports Autodesk.AutoCAD.Colors
Imports Autodesk.AutoCAD.Windows
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.ApplicationServices
Public Class Class1
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
<CommandMethod("SApoints")> _
Public Sub createLine()
Dim CSV_FileName As String = Nothing
' navigate to the point text csv file using a file dialog
Dim dlg As New System.Windows.Forms.OpenFileDialog()
dlg.InitialDirectory = "C:\"
dlg.Filter = "csv text files (*.txt)|*.txt|csv excel files (*.csv)|*.csv|All files (*.*)|*.*"
If dlg.ShowDialog() = Windows.Forms.DialogResult.OK Then
CSV_FileName = dlg.FileName().ToString
' call sub to create points from CSV file
readCSVPoints(CSV_FileName)
Else
' if canceled write to the command line and sub not called
ed.WriteMessage(vbCr & " command canceled")
End If
End Sub
Public Sub readCSVPoints(ByVal CSV_FileName As String)
Dim myPath As String = CSV_FileName
' Start a transaction
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
' Open the Block table for read
Dim acBlkTbl As BlockTable
acBlkTbl = CType(acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead), BlockTable)
' Open the Block table record Model space for write
Dim acBlkTblRec As BlockTableRecord
acBlkTblRec = CType(acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
' Read a line containing (point ID, x, y, z) points from a text file that contains coordinates
Dim inputRecord As String = Nothing
Dim myPoints(3) As String
Dim x, y, z As Double
' point ID
Dim pid As String
Dim inReader As StreamReader = File.OpenText(myPath)
' Start reading text file one line at a time
inputRecord = inReader.ReadLine()
While (inputRecord IsNot Nothing)
If inputRecord.Contains(",") Then
myPoints = inputRecord.Split(CChar(",")) ' get code string
pid = (myPoints(0).Trim)
x = CDbl(myPoints(1).Trim)
y = CDbl(myPoints(2).Trim)
z = CDbl(myPoints(3).Trim)
' Create a point at (x, y, z) in Model space
Dim acPoint As DBPoint = New DBPoint(New Point3d(x, y, z))
acPoint.SetDatabaseDefaults()
' create point ID text with single line text i.e. (p1 text just above the point)
Dim acText As DBText = New DBText()
acText.SetDatabaseDefaults()
acText.Position = New Point3d((x - 0.25), (y + 0.075), z)
acText.Height = 0.125
acText.TextString = pid
' call sub and place items on a layer of their own
CreateLayer(acPoint, acText)
' Add the new object to the block table record and the transaction
acBlkTblRec.AppendEntity(acText)
acTrans.AddNewlyCreatedDBObject(acText, True)
' Add the new object to the block table record and the transaction
acBlkTblRec.AppendEntity(acPoint)
acTrans.AddNewlyCreatedDBObject(acPoint, True)
End If
' Read next line
inputRecord = inReader.ReadLine()
End While ' will end at EOF or keep looping
' Set the style for all point objects in the drawing
acCurDb.Pdmode = 32 ' point style circle w/dot
acCurDb.Pdsize = 0.125 ' value 1 or more is absolute size; 0 is 5%
' set iso mode
ToIsoView()
' zoom all
SendACommandToAutoCAD()
' now write to the command line
ed.WriteMessage(vbCr & "all points are in")
' save the new object to the database
acTrans.Commit()
' close reader to text file
inReader.Close()
End Using
End Sub
Public Sub CreateLayer(ByVal acPoint As DBPoint, ByVal acText As DBText)
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
' Open the Layer table for read
Dim acLyrTbl As LayerTable
acLyrTbl = CType(acTrans.GetObject(acCurDb.LayerTableId, OpenMode.ForRead), LayerTable)
Dim pLayerName As String = "110"
Dim pidLayerName As String = "109"
If acLyrTbl.Has(pLayerName) = False Then
Dim acLyrTblRec As LayerTableRecord = New LayerTableRecord()
' Assign the layer the ACI color 1 and a name
acLyrTblRec.Color = Color.FromColorIndex(ColorMethod.ByAci, 1)
acLyrTblRec.Name = pLayerName
' Upgrade the Layer table for write
acLyrTbl.UpgradeOpen()
' Append the new layer to the Layer table and the transaction
acLyrTbl.Add(acLyrTblRec)
acTrans.AddNewlyCreatedDBObject(acLyrTblRec, True)
End If
If acLyrTbl.Has(pidLayerName) = False Then
Dim acLyrTblRec As LayerTableRecord = New LayerTableRecord()
' Assign the layer the ACI color 1 and a name
acLyrTblRec.Color = Color.FromColorIndex(ColorMethod.ByAci, 5)
acLyrTblRec.Name = pidLayerName
' Upgrade the Layer table for write
acLyrTbl.UpgradeOpen()
' Append the new layer to the Layer table and the transaction
acLyrTbl.Add(acLyrTblRec)
acTrans.AddNewlyCreatedDBObject(acLyrTblRec, True)
End If
' set each point to this layer
acPoint.Layer = pLayerName
' set each point ID to this layer
acText.Layer = pidLayerName
' Save the changes and dispose of the transaction
acTrans.Commit()
End Using
End Sub
' zoom all
Public Sub SendACommandToAutoCAD()
' limits of the drawing
acDoc.SendStringToExecute("._zoom _all ", True, False, False)
End Sub
Public Sub ToIsoView()
Dim vtr As ViewTableRecord = ed.GetCurrentView()
Dim newVtr As ViewTableRecord = vtr
newVtr.ViewDirection = New Vector3d(1, -1, 1)
ed.SetCurrentView(newVtr)
End Sub
End Class
第3d点。txt文件 在这个论坛软件中有没有办法使代码窗格足够大以正确阅读代码。
在一个24英寸的显示器上,代码窗格占据了大约四分之一的屏幕……真是浪费!!
...
[添加]
.. 此外,观众需要垂直和水平滚动才能了解意图。
做得好。输入20000点肯定需要自动化。不过,我不得不说,您包含的示例点文件是一个相当无聊的形状。
非常感谢。
我很乐意与大家分享我在10-2万分下的作品,但是。。。。。。。。。我的工作场所有规矩,我必须遵守!
我理解。
对上述代码的另一个窥视引发了一些建议:
如果层分配不是CreateLayer子的一部分,那么可以在“While”循环之前调用该子,并避免重复的StartTransactions和LayerTable打开。在保证层已经存在的情况下,层分配可以在循环内发生。
用户将文本/点放入模型空间是有意义的,但该程序允许在纸面空间中调用自己。实体显式添加到适当的BlockTableRecord中不一定是问题,除非
纸张空间中不允许newVtr.ViewDirection = New Vector3d(1, -1, 1)。
感谢这些建议,我可以对ToIsoView()Sub和ZoomAll进行评论;我很难找到一个使用AutoCAD 2008的示例,我看到的AutoCAD开发者指南似乎是2011版的。
页:
[1]