matt41129 Posted August 8, 2008 Share Posted August 8, 2008 Hello everybody, Im kinda new to code. I know there is a way but im unsure how to approach it. I have about 100+ drawings to insert a simple text line into a set corrdinate. But the text will have to change in every drawings. Is there a way to link excel and autocad so i can tell it what cell to insert into autocad at a certain coordiante and rotation? I guess what im trying to say is i have 100+ diffrent numbers that i need to insert into 100+ drawings (one number per drawing_ and i have all of the numbers on a spreadsheet. I just need them to insert at a certain coordinate, rotate 90 degrees counter clockwise. Any ideas and/or solutions? Thanks for any help you guys can give me. Im really new to code and not sure where to begin. I have around 7yrs experience in autocad, but never fooled with code that much, but im trying to get into lisp's. I have wrote a occasional macro but nothing big. Any and all help is appreciative... Matt H. Quote Link to comment Share on other sites More sharing options...
CmdrDuh Posted August 8, 2008 Share Posted August 8, 2008 It can defieitly be done, I would suggest a combo of code and script file. I ahve a VBA solution you could start with and tweak if you want Quote Link to comment Share on other sites More sharing options...
matt41129 Posted August 8, 2008 Author Share Posted August 8, 2008 Yeah sure any help is appreciated. Thanks alot. Quote Link to comment Share on other sites More sharing options...
CmdrDuh Posted August 8, 2008 Share Posted August 8, 2008 This code populates a block attributes with data from excel, it can be tweaked to do text instead. Option Explicit Public Sub PushAttributes() Dim objSelSet As AcadSelectionSet Dim objExcel As Excel.Application Dim objExcelSheet As Excel.Worksheet Dim intActR As Integer Dim blnFoundAttributes As Boolean Dim blnRunning As Boolean Dim strDwgNo As String Dim strProjectName As String Dim strLogName As String Dim foundCell As Range Dim intType(0 To 1) As Integer Dim varData(0 To 1) As Variant Dim objBlkRef As AcadBlockReference Dim atts As Variant Dim objSelCol As AcadSelectionSets Dim XL(6) As String Dim objAttRef As AcadAttributeReference On Error GoTo Err_Control: ThisDrawing.SetVariable "PROJECTNAME", "PushAtts" Set objSelCol = ThisDrawing.SelectionSets If objSelCol.Count > 0 Then For Each objSelSet In objSelCol If objSelSet.Name = "Title" Then objSelSet.Delete Exit For End If Next End If strProjectName = ThisDrawing.GetVariable("Projectname") strLogName = "c:\PMS\" & strProjectName & ".xls" blnRunning = IsAppRunning If blnRunning Then Set objExcel = GetObject(, "Excel.Application") If objExcel.ActiveWorkbook = strProjectName Then objExcel.Workbooks.Open strLogName Set objExcelSheet = objExcel.ActiveWorkbook.Sheets("Sheet1") End If Else Set objExcel = CreateObject("Excel.Application") objExcel.UserControl = True objExcel.Visible = True objExcel.Workbooks.Open strLogName objExcel.Sheets("Sheet1").Activate Set objExcelSheet = objExcel.ActiveWorkbook.Sheets("Sheet1") End If ' objExcel.Workbooks.Open strLogName ' Set objExcelSheet = objExcel.ActiveWorkbook.Sheets("Sheet1") strDwgNo = Left(ThisDrawing.Name, Len(ThisDrawing.Name) - 4) Set foundCell = objExcelSheet.Range("b4", objExcelSheet.Range("b4").End(xlDown)).Find(strDwgNo) If foundCell Is Nothing Then MsgBox ("Did not find a drawing #") objExcel.ActiveWorkbook.Save objExcel.Quit Exit Sub Else foundCell.Activate intActR = objExcel.ActiveCell.Row Set foundCell = Nothing End If XL(0) = StrConv(objExcelSheet.Cells(intActR, 1).Value, 1) 'Sheet Number XL(1) = StrConv(objExcelSheet.Cells(intActR, 2).Value, 1) 'Drawing Number XL(2) = StrConv(objExcelSheet.Cells(intActR, 3).Value, 1) 'Revision Number XL(3) = StrConv(objExcelSheet.Cells(intActR, 4).Value, 1) 'Code Number XL(4) = StrConv(objExcelSheet.Cells(intActR, 5).Value, 1) 'Line 1 XL(5) = StrConv(objExcelSheet.Cells(intActR, 6).Value, 1) 'Line 2 XL(6) = StrConv(objExcelSheet.Cells(intActR, 7).Value, 1) 'Line 3 Set objSelSet = objSelCol.Add("Title") intType(0) = 0: varData(0) = "INSERT" intType(1) = 2: varData(1) = "TITLINFO,VTITLINFO,8.5x11_BDR,vinfo" objSelSet.Select Mode:=acSelectionSetAll, filtertype:=intType, filterdata:=varData For Each objBlkRef In objSelSet If objBlkRef.HasAttributes Then blnFoundAttributes = True atts = objBlkRef.GetAttributes Set objAttRef = atts(0) objAttRef.TextString = XL(4) Set objAttRef = atts(1) objAttRef.TextString = XL(5) Set objAttRef = atts(2) objAttRef.TextString = XL(6) Set objAttRef = atts(3) objAttRef.TextString = XL(1) Set objAttRef = atts(4) objAttRef.TextString = XL(2) Set objAttRef = atts(5) objAttRef.TextString = XL(3) Set objAttRef = atts(6) objAttRef.TextString = XL(0) End If Next objBlkRef If Not blnRunning Then 'We started the instance, so we can close it objExcel.ActiveWorkbook.Save objExcel.Quit End If ThisDrawing.Save Exit_Here: strDwgNo = "" ThisDrawing.SetVariable "PROJECTNAME", "." Set objExcel = Nothing Set objExcelSheet = Nothing Exit Sub Err_Control: objExcel.Quit Set objExcel = Nothing Set objExcelSheet = Nothing MsgBox Err.Description, vbOKOnly, Err.Number Resume Exit_Here End Sub 'This determines how to set the Excel instance. Private Function IsAppRunning() As Boolean Dim objExcel As Excel.Application On Error Resume Next Set objExcel = GetObject(, "Excel.Application") IsAppRunning = (Err.Number = 0) Set objExcel = Nothing Err.Clear End Function Quote Link to comment Share on other sites More sharing options...
fixo Posted August 8, 2008 Share Posted August 8, 2008 Hello everybody, Im kinda new to code. I know there is a way but im unsure how to approach it. I have about 100+ drawings to insert a simple text line into a set corrdinate. But the text will have to change in every drawings. Is there a way to link excel and autocad so i can tell it what cell to insert into autocad at a certain coordiante and rotation? I guess what im trying to say is i have 100+ diffrent numbers that i need to insert into 100+ drawings (one number per drawing_ and i have all of the numbers on a spreadsheet. I just need them to insert at a certain coordinate, rotate 90 degrees counter clockwise. Any ideas and/or solutions? Thanks for any help you guys can give me. Im really new to code and not sure where to begin. I have around 7yrs experience in autocad, but never fooled with code that much, but im trying to get into lisp's. I have wrote a occasional macro but nothing big. Any and all help is appreciative... Matt H. Try this lisp to insert text into model space of drawings ;; btx.lsp (vl-load-com) (defun EXR (FilePath ShtNum Address / ExcelApp ExcData Sht UsdRange Wbk) (setq ExcelApp (vlax-get-or-create-object "Excel.Application")) (vla-put-visible ExcelApp :vlax-false) ; or :vlax-true if you want (vlax-put-property ExcelApp 'DisplayAlerts :vlax-false) (setq Wbk (vl-catch-all-apply 'vla-open (list (vlax-get-property ExcelApp "WorkBooks") FilePath) ) ) (setq Sht (vl-catch-all-apply 'vlax-get-property (list (vlax-get-property Wbk "Sheets") "Item" ShtNum ) ) ) (vlax-invoke-method Sht "Activate") ;; *** this piece of code is what you need : (setq UsdRange (vlax-get-property (vlax-get-property Sht 'Cells) "Range" Address) ExcData (vlax-safearray->list (vlax-variant-value (vlax-get-property UsdRange 'Value2) ) ) );*** (setq ExcData (mapcar (function (lambda (x) (mapcar 'vlax-variant-value x))) ExcData ) ) (vl-catch-all-apply 'vlax-invoke-method (list Wbk "Close") ) (vl-catch-all-apply 'vlax-invoke-method (list ExcelApp "Quit") ) (mapcar (function (lambda (x) (vl-catch-all-apply (function (lambda () (progn (if (not (vlax-object-released-p x)) (progn (vlax-release-object x) (setq x nil) ) ) ) ) ) ) ) ) (list UsdRange Sht Wbk ExcelApp) ) (gc) (gc) ExcData ) ; main programm : (defun C:BTX (/ Acsp Adoc Data Filepath File_Name Ins_Point Shtnum Txt_Height Txt_String) (alert "\tBe patience...\nWorks slowly") (setq FilePath (getfiled "Select Excel file to get data:" (getvar "dwgprefix") "xls" 16 ) ) (setq ShtNum (getint "\nEnter sheet number (or hit ENTER to set default) <1>:")) (if (not ShtNum) (setq ShtNum 1) ) (setq data (EXR FilePath ShtNum "A2:E9"));<-- change an address of diapazone here (setq txt_height (getreal "\nEnter the text height: ")) (foreach row data (setq file_name (nth 0 row) ins_point (list (atof (nth 1 row)) (atof (nth 2 row)) (atof (nth 3 row)) ) txt_string (nth 4 row) ) (setq adoc (vla-open (vla-get-documents (vlax-get-acad-object)) file_name :vlax-false) ) (setq acsp (vla-get-modelspace adoc)) (setq txt_obj (vla-addtext acsp txt_string (vlax-3d-point ins_point) txt_height)) (vla-put-rotation txt_obj (/ pi 2));<-- set rotation you need here (vla-saveas adoc file_name acNative) (vla-close adoc) ) (princ) ) (princ "\n") (princ "\n\t\t<<<\t Start command with BTX\t >>>") (princ) Your Excel file columns must looks like : Headers: DrawingName | Xcoordinate | Ycoordinate | ZCoordinate | TextString C:\Temp\Some.dwg..........0............0...........0...............Blabla.... where DrawingName is the full path of drawing ~'J'~ Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.