Inserting Text with Code!?

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.

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

Yeah sure any help is appreciated. Thanks alot.

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

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'~