plot x,y and z coordinate using AutoCAD VB

[mien]

how to plot x,y,z coordinates using autocad VB...can someone give me the script plss

 

email me at red_wing86@yahoo.com or add me as ur friend using yahoo massenger

[Lee Mac]

It would be better if the answer was posted on the forums, as other users could benefit from the code provided

[Lee Mac]

When you say

plot x,y,z coordinates

what do you mean exactly?

 

print coordinates of certain objects to external files? i.e. coords of points to text or excel files...

 

Could you please explain further

 

Thanks

 

Lee

[dbroada]

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.

[Lee Mac]

A plot window...

 

maybe something using EXTMIN and EXTMAX?

[mien]

When you say what do you mean exactly?

 

print coordinates of certain objects to external files? i.e. coords of points to text or excel files...

 

Could you please explain further

 

Thanks

 

Lee

 

coordinate from excel or txt file..plot to autocad using visual basic..

can someone teach me...thanks

[dvhardy]

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.

 

 

 
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

[mien]

thankssssss dvhardy...i will try it..

[Lee Mac]

dvhardy, would you be able to post your code in future within

 [/ code] tags as it makes it easier to read, follow and copy 
 
Thanks
 
Lee

[mien]

can someone teach me how to class the layer according to height range using visual basic or lips..thanks..

[dvhardy]

Ah, I didn't realise I could do that, sorry.

 

Also, this code is a modified version of something I found (but have since lost the link to). The original article mentioned something rather clever to do with positioning labels dynamically so there were no overlaps. The code for that wasn't included so I just used an attribute.

 

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"

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

[mien]

dear dvhardy, can u a give me an example complete visual basic programming for autocad for me to study it structure and function.thanks....

[dvhardy]

Try browsing the AutoCAD ActiveX and VBA References in the help documentation to find out more about AutoCAD's object model.

 

ps I'm not actually an AutoCAD user (yet) and know next to nothing about the software. I just wanted to do what you wanted to and thought it must be possible.

 

I'm thinking of buying the book 'AutoCAD 2006 VBA: A Programmer's Reference' which gets a few good reviews on Amazon (there don't appear to be many books covering the subject)

[dbroada]

ps I'm not actually an AutoCAD user (yet) and know next to nothing about the software. I just wanted to do what you wanted to and thought it must be possible.

You and Lee should get on really well! If I've understood him correctly, he is in a similar position with LISP - just doing it because he can.

[Lee Mac]

You and Lee should get on really well! If I've understood him correctly, he is in a similar position with LISP - just doing it because he can.

 

You can read me like a book Dave,

 

I only have around 1 year's experience in drafting, but find the LISP quite understandable - which is why I spend most of my time in this forum and don't venture much into the ACAD general side of things...