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 StringPublic blnBlockLabelFailure As BooleanPublic mstrImportType As StringPublic Sub ReadXYFile(strFileName As String)'mstrBlockName was set on userform before calling this sub routineDim myFile As IntegerDim lngIndex As LongDim strTextLine As StringDim arrText As VariantDim intCol As IntegerDim intSubStrings As IntegerDim dblX As DoubleDim dblY As DoubleDim dblZ As DoubleDim 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 TidyUpAndExitEnd IfmyFile = FreeFileOpen strFileName For Input As #myFileDo 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 + 1LoopTidyUpAndExit: '**** tidy up e.g. close and set objects to nothing Close myFileExit SubErrorHandlerPoint: 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 TidyUpAndExitEnd SubSub InsertBlock(xx As Double, yy As Double, zz As Double, bAttr As String)Dim insertionPnt(0 To 2) As DoubleDim blockRefObj As AcadBlockReferenceDim varAttribs As VariantDim intAttribCount As Integer'Coordinate 'x=0,y=1,z=2insertionPnt(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 flagintAttribCount = 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).UpdateEnd IfTidyUpAndExit: '**** tidy up e.g. close and set objects to nothingExit SubErrorHandlerPoint: 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 TidyUpAndExitEnd Sub dear dvhardy, can u a give me an example complete visual basic programming for autocad for me to study it structure and function.thanks.... 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) 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...
页:
1
[2]