It would be better if the answer was posted on the forums, as other users could benefit from the code provided
Registered forum members do not see this ad.
how to plot x,y,z coordinates using autocad VB...can someone give me the script plss
email me at firstname.lastname@example.org or add me as ur friend using yahoo massenger
When you saywhat do you mean exactly?plot x,y,z coordinates
print coordinates of certain objects to external files? i.e. coords of points to text or excel files...
Could you please explain further
I assumed the OP wanted a plot window.
I didn't reply as I didn't have an answer but I did manage to stop myself posting saying answers should be posted in forum. Now you've done that I can agree.
"That's it. It's one thing for a ghost to terrorize my children, but quite another for him to play my Theremin." Homer Simpson
"Everything in drafting is logical. Except what isn’t." - Gavin Guile. (from the Lightbringer series of books by Brent Weeks)
This is my first post and it may or may not be what you're after. I suggest you read and try to understand the code as my error handling here is not the best. I have a user form for picking the file and blocks (which are passed to the routines below) but I can't see how to attach anything here.
The following code will place blocks at coordinates read from a csv text file (x,y,z,name or x,y,name - your could change the column order easily if you wanted, I just haven't got around to it). The 'name' will be placed if the specified block has an attribute.
The block you want to use must exist within the dwg.
The file format is a csv file of either 4 columns (x,y,z,name) or 3 columns(x,y,name).
Make sure no coordinates are missing.
For 'x,y,name' a z value of 0 is assumed.
Code:Public mstrBlockName As String Public blnBlockLabelFailure As Boolean Public mstrImportType As String Public Sub ReadXYFile(strFileName As String) 'mstrBlockName was set on userform before calling this sub routine Dim myFile As Integer Dim lngIndex As Long Dim strTextLine As String Dim arrText As Variant Dim intCol As Integer Dim intSubStrings As Integer Dim dblX As Double Dim dblY As Double Dim dblZ As Double Dim strName As String 'strFileName = "C:\GIS\COORD_TEST3.csv" 'change this to your file On Error GoTo ErrorHandlerPoint ' TODO: Take this check out, have already checked on form. If Dir(strFileName) = "" Then Call MsgBox(strFileName & " not found", vbExclamation, "Import XYZ Coordinates") GoTo TidyUpAndExit End If myFile = FreeFile Open strFileName For Input As #myFile Do While Not EOF(myFile) Line Input #myFile, strTextLine arrText = Split(strTextLine, ",") If lngIndex = 0 Then ' read first line to determine number columns in file intSubStrings = UBound(arrText) 'Debug.Print intSubStrings If intSubStrings = 2 Then 'i.e. 3 columns, we are expecting X,Y,Name mstrImportType = "XYName" ElseIf intSubStrings = 3 Then 'i.e. 4 columns, we are expecting X,Y,Z and Name mstrImportType = "XYZName" Else mstrImportType = "" Call MsgBox("The chosen file was invalid." & _ vbCrLf & "" & _ vbCrLf & "File must comprise 3 (X,Y,Name) or 4 (X,Y,Z,Name) columns of data only.", vbExclamation, "Import XYZ Coordinates") GoTo TidyUpAndExit End If End If 'if the columns are in the wrong order a type mismatch error will be thrown by the error handler Select Case mstrImportType Case "XYName" dblX = arrText(0) dblY = arrText(1) dblZ = 0 strName = arrText(2) Call InsertBlock(dblX, dblY, dblZ, strName) Case "XYZName" dblX = arrText(0) dblY = arrText(1) dblZ = arrText(2) strName = arrText(3) Call InsertBlock(dblX, dblY, dblZ, strName) Case Else '???????????? End Select lngIndex = lngIndex + 1 Loop TidyUpAndExit: '**** tidy up e.g. close and set objects to nothing Close myFile Exit Sub ErrorHandlerPoint: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ReadXYFile" 'could try to catch specific error, e.g possible type mismatch and provide meaningful message GoTo TidyUpAndExit End Sub Sub InsertBlock(xx As Double, yy As Double, zz As Double, bAttr As String) Dim insertionPnt(0 To 2) As Double Dim blockRefObj As AcadBlockReference Dim varAttribs As Variant Dim intAttribCount As Integer 'Coordinate 'x=0,y=1,z=2 insertionPnt(0) = xx#: insertionPnt(1) = yy#: insertionPnt(2) = 0 'InsertBlock inserts a drawing file or a named block that has been defined in the current drawing. Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, mstrBlockName, 1#, 1#, 1#, 0) ' Get attribute value(s) from the block. varAttribs = blockRefObj.GetAttributes 'Check how many attributes the block - if 0 set a boolean flag intAttribCount = UBound(varAttribs) If intAttribCount = -1 Then ' The block has no attributes blnBlockLabelFailure = True 'Call MsgBox("The chosen block has no attributes to label.", vbInformation, "Import XYZ Coordinates") Else ' We will use only the First attribute in the block found at location Zero. ' varAttribs(0) is the first block attribute value. ' Note, most programs uses Zero-based counting & therefore the first number is Zero when counting rather than one. varAttribs(0).TextString = bAttr ' Update the block so we can see the new Values applied to the block attribute values above. ' This is similar to a localized regen, only the block is updated/regenerated. varAttribs(0).Update End If TidyUpAndExit: '**** tidy up e.g. close and set objects to nothing Exit Sub ErrorHandlerPoint: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure InsertBlock" 'could try to catch specific error, e.g possible type mismatch and provide meaningful message GoTo TidyUpAndExit End Sub
Last edited by fuccaro; 25th Feb 2009 at 09:14 am. Reason: added CODE tags
thankssssss dvhardy...i will try it..
Registered forum members do not see this ad.
can someone teach me how to class the layer according to height range using visual basic or lips..thanks..