Block placment using Excel

Hello all,

I hope someone can help me? I am doing a survey to help a friend to build a specially designed house for his disabled son.

I have looked at the other posts but cannot see anything to match my problem.

I have done the survey with an EDM but it has no on board logging and I have a excel spread sheet of Easting, Northing and levels. (I am use to on board logging so not come over this problem in the past)

Eg

East North Level

1000 1000 50

I have an AutoCAD block with a cross and an attribute assigned to it for the level. What I am after is a lisp routine to take over 100 points and place the block I have at the coordinates and input the level figure as the attribute. Using the example above the intersection of the cross will be at 1000, 1000 and the text on screen will read 50.

The last time I done a simple lisp routine was 6 years ago so I will say I cannot remember anything.

I am using AutoCAD 2008 and Excel 2003.

Any help gratefully received; otherwise it is insert block and plug everything by hand.

Regards

Rich

Hi Rich

Welcome on board

Here is my old one, partially written by my friend

Try this out

;;pix.lsp
(vl-load-com)
;;==============================get Excel data==================================;;
(defun EXD  (/ ExcelApp ExcData FilePath Sht ShtNum UsdRange Wbk)


 (setq	FilePath (getfiled "Select Excel file to read :"
		   (getvar "dwgprefix")
		   "xls"
		   16
		   )
)

 (setq ShtNum (getint "\nEnter sheet number : "))

 (setq ExcelApp (vlax-get-or-create-object "Excel.Application"))
 (vla-put-visible ExcelApp :vlax-true)
 (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")
 (setq	UsdRange (vlax-get-property Sht 'UsedRange)
ExcData	 (vlax-safearray->list
	   (vlax-variant-value
	     (vlax-get-property UsdRange 'Value)
	     )
	   )
)					  ;or 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
 )


(defun C:PIX  (/ layername point_info response x y z)
 
 (if (not (tblsearch "BLOCK" "TOPO_POINT"))
   (progn
     (setvar "PDMODE" 35)
     (setvar "PDSIZE" 0.5)
     (entmake
(mapcar	'cons
	(list 0 8 2 70 10 3)
	(list "BLOCK" "0" "TOPO_POINT" 2 '(0 0 0) "TOPO_POINT")))
     (entmake
(mapcar	'cons
	(list 0 8 62 10 210 50)
	(list "POINT" "0" 0 '(0 0 0) '(0 0 1) 0.0)))
     (entmake
(mapcar	'cons
	(list 0 8 62 10 40 70 1 210 3 2)
	(list "ATTDEF"
	      "0"
	      0
	      '(-1 0 0)
	      2.5
	      0
	      ""
	      '(0 0 1)
	      "Point number"
	      "TOPO_POINT_ELEVATION")))
     (entmake
(mapcar	'cons
	(list 0 
	(list "ENDBLK" "0")))))
				
 (if (not (tblsearch "STYLE" "TOPO"))
   (progn
     (command "_.STYLE"
       "TOPO"
       "SIMPLEX.SHX"
       "0"
       "1.0"
       "0"
       ""
       ""
       "")
     ))
 (setq layername (getstring T "\nEnter layer name for topo points: "))
 (if
   (setq point_info (EXD))
    (progn
      (initget "Yes No")
      (setq response (getkword "\nHave an Excel table the headers? (Y/N) <Y>"))
      (if (not response)
   (setq response "Yes")
   )
      (if (eq response "Yes")(setq point_info (cdr point_info)))
      (foreach	row  point_info
 (mapcar 'set (list 'x 'y 'z) row)
 (entmake
   (mapcar 'cons
	   (list 0 8 62 66 2 10 210)
	   (list "INSERT"
		 layername
		 256
		 1
		 "TOPO_POINT"
		 (list x y z)
		 '(0 0 1))))
 (entmake
   (mapcar 'cons
	   (list 0 7 8 62 10 40 1 2 70 210)
	   (list "ATTRIB"
		 "TOPO"
		 layername
		 256
		 (append (mapcar '1+ (list x (+ y 0.5)))
			 (list (- z z)))
		 0.8
		 (rtos z 2 0)
		 "TOPO_POINT_NUMBER"
		 0
		 '(0 0 1))))
 (entmake
   (mapcar 'cons
	   (list 0 8 62)
	   (list "SEQEND" layername 256)))))
    (prompt "\nProblem with Excel. Try again.")
    )
 (princ)
 )
(princ "\n Start command with PiX ...")
(princ)

~'J'~

flixo, your lisp program work great! Thanks, is there a way you could add a second attribute to the block to read a fourth column in the spread sheet? This would be for the point name (text ie NB512). Thanks for any help.

Welcome on board, capthedrafter

Can you upload the sample drawing with this block,

better yet in A2007 format?

~'J'~

WP ONE.dwg

the drawing is attached

Ok I got it,

Will back in tomorrow,

See you later

~'J'~

[ATTACH]36451[/ATTACH]

the drawing is attached

I just added forth number as point description,

see how it works on your end

 
;;pix.lsp
;;edited 8/9/12
(vl-load-com)
;;==============================get Excel data==================================;;
(defun EXD (/ ExcelApp ExcData FilePath Sht ShtNum UsdRange Wbk)

(setq FilePath (getfiled "Select Excel file to read :"
(getvar "dwgprefix")
"xls"
16
)
)
(setq ShtNum (getint "\nEnter sheet number : "))
(setq ExcelApp (vlax-get-or-create-object "Excel.Application"))
(vla-put-visible ExcelApp :vlax-true)
(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")
(setq UsdRange (vlax-get-property Sht 'UsedRange)
ExcData (vlax-safearray->list
(vlax-variant-value
(vlax-get-property UsdRange 'Value)
)
)
) ;or 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
)

(defun C:PIX (/ layername point_info response x y z)

(if (not (tblsearch "BLOCK" "TOPO_POINT"))
(progn
(setvar "PDMODE" 35)
(setvar "PDSIZE" 0.5)
(entmake
(mapcar 'cons
(list 0 8 2 70 10 3)
(list "BLOCK" "0" "TOPO_POINT" 2 '(0 0 0) "TOPO_POINT")))
(entmake
(mapcar 'cons
(list 0 8 62 10 210 50)
(list "POINT" "0" 0 '(0 0 0) '(0 0 1) 0.0)))
(entmake
(mapcar 'cons
(list 0 8 62 10 40 70 1 210 3 2)
(list "ATTDEF"
"0"
0
'(-1 0 0)
2.5
0
""
'(0 0 1)
"Point number"
"TOPO_POINT_ELEVATION")))
(entmake
(mapcar 'cons
(list 0 
(list "ENDBLK" "0")))))

(if (not (tblsearch "STYLE" "TOPO"))
(progn
(command "_.STYLE"
"TOPO"
"SIMPLEX.SHX"
"0"
"1.0"
"0"
""
""
"")
))
(setq layername (getstring T "\nEnter layer name for topo points: "))
(if
(setq point_info (EXD))
(progn
(initget "Yes No")
(setq response (getkword "\nHave an Excel table the headers? (Y/N) <Y>"))
(if (not response)
(setq response "Yes")
)
(if (eq response "Yes")(setq point_info (cdr point_info)))
(foreach row point_info
(mapcar 'set (list 'x 'y 'z 'n) row)
(entmake
(mapcar 'cons
(list 0 8 62 66 2 10 210)
(list "INSERT"
layername
256
1
"TOPO_POINT"
(list x y z)
'(0 0 1))))
(entmake
(mapcar 'cons
(list 0 7 8 62 10 40 1 2 70 210)
(list "ATTRIB"
"TOPO"
layername
256
(append (mapcar '1+ (list x (+ y 0.5)))
(list (- z z)))
0.8
n ;(rtos z 2 0)
"TOPO_POINT_NUMBER"
0
'(0 0 1))))
(entmake
(mapcar 'cons
(list 0 8 62)
(list "SEQEND" layername 256)))))
(prompt "\nProblem with Excel. Try again.")
)
(princ)
)
(princ "\n Start command with PiX ...")
(princ)

~'J'~

It works GREAT. Thank you for your help.

You're welcome,

Cheers

~'J'~

Hi again, after working with a little bit it is not working the way I intended. I would like a block inserted with two tags one with the elevation and one with the point name. Please see attached refs. Thanks for your help once again.

Sample Points.xlsx

POINT.dwg

wait please

Try edited version, I have enough time for the test,

so let me know, what we need to change:

 
;; pix.lsp v.2
;; edited 8/9/12
;; edited 8/20/12
(vl-load-com)
;;==============================get Excel data==================================;;
(defun EXD  (/ ExcelApp ExcData FilePath Sht ShtNum UsdRange Wbk)

 (setq FilePath (getfiled "Select Excel file to read :"
     (getvar "dwgprefix")
     "xlsx;xls"
     16
     )
)
 (setq ShtNum (getint "\nEnter sheet number : "))
 (setq ExcelApp (vlax-get-or-create-object "Excel.Application"))
 (vla-put-visible ExcelApp :vlax-true)
 (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")
 (setq UsdRange (vlax-get-property Sht 'UsedRange)
ExcData  (vlax-safearray->list
    (vlax-variant-value
      (vlax-get-property UsdRange 'Value)
      )
    )
)       ;or 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
 )
;;---------------------------Create layer-----------------------------;;
(defun _make_layer  (lname ltyp lwt col plot desc)
 (if (not (tblsearch "LAYER" lname))    ;layer name
   (progn
     (setq new_layer
     (vla-add
       (vla-get-layers
  (vla-get-activedocument
    (vlax-get-acad-object)))
       lname)
    )
     )
   )
 (vla-put-description new_layer desc)    ;description
 (vla-put-linetype
   new_layer
   (if (tblsearch "LTYPE" ltyp)
     ltyp       ;linetype
     "Continuous"))
 (vlax-put new_layer 'Lineweight lwt)    ;lineweight
 (vla-put-plottable
   new_layer
   (if plot
     :vlax-true
     :vlax-false))      ;plottable
 (setq accol (vla-getinterfaceobject
 (vlax-get-acad-object)
 (strcat "AutoCAD.AcCmColor."
  (itoa (atoi (getvar "acadver")))))
)
 (vla-put-colorindex accol col)
 (vla-put-truecolor new_layer accol)    ;color
 (vlax-release-object accol)
 )
(defun C:PIX  (/ layername numheaders point_info response x y z n)
 (if (not (tblsearch "STYLE" "STD"))
   (progn
     (command "_.STYLE"
       "STD"
       "romans.shx"
       "0"
       "0.8"
       "0"
       ""
       ""
       "")
     ))
 (if (not (tblsearch "BLOCK" "TOPO_POINT"))
   (progn
     (setvar "PDMODE" 35)
     (setvar "PDSIZE" 0.5)
     (entmake
(mapcar 'cons
 (list 0 8 2 70 10 3)
 (list "BLOCK" "0" "TOPO_POINT" 2 '(0 0 0) "POINT")))
     (entmake
(mapcar 'cons
 (list 0 8 62 10 210 )
 (list "POINT" "0" 0 '(0 0 0) '(0 0 1) )))
     (entmake
(mapcar 'cons
 (list 0 8 62 10 40 41 7 70 1 210 3 2 72 73)
 (list "ATTDEF"
       "0"
       0
       '(0.6875  0.1875 0)
       0.1875
       0.8
       "STD"
       0
       "POINT ELEVATION"
       '(0 0 1)
       "Point elevation"
       "POINT_ELEVATION"
       0
       2)))
     (entmake
(mapcar 'cons
 (list 0 8 62 10 40 41 7 70 1 210 3 2 72 73)
 (list "ATTDEF"
       "0"
       0
       '(0.6875 -0.1875 0)
       0.1875
       0.8
       "STD"
       0
       "POINT NAME"
       '(0 0 1)
       "Point name"
       "POINT_NAME"
       0
       2)))
     (entmake
(mapcar 'cons
 (list 0 
 (list "ENDBLK" "0")))))


 (setq layername (getstring T "\nEnter layer name for topo points <TOPO>: "))
 (cond ((eq "" layername)(setq layername "TOPO")))

 (if (not (tblsearch "layer" layername))
   (_make_layer
   layername       ;layer name
   "Continuous"       ;linetype
   0        ;lineweight
   0        ;color / default / byblock
   T        ;plottable
   "Layer description is goes here"    ; <--- change layer description here *********************************
   ))

 (if
   (setq point_info (EXD))
    (progn
;;;       (initget "Yes No")
;;;       (setq response (getkword "\nHave an Excel table the headers? (Y/N) <Y>"))
;;;       (if (not response)
;;;    (setq response "Yes")
;;;    )
;;;       (if (eq response "Yes")(setq point_info (cdr point_info)))
      (initget 5)
      (setq numheaders (getint "\nHow many header rows in the Excel table? : "))

      (if (> numheaders 0)
 (progn

   (repeat numheaders
     (setq point_info (cdr point_info))
    )))
      (foreach row  point_info
 (mapcar 'set (list 'x 'y 'z 'n) row)
 (entmake
   (mapcar 'cons
    (list 0 8 62 66 2 10 210)
    (list "INSERT"
   layername
   256
   1
   "TOPO_POINT"
   (list x y z)
   '(0 0 1))))

 (entmake
   (mapcar 'cons
    (list 0 7 8 62 10 40 1 2 70 71 73 210)
    (list "ATTRIB"
   "STD"
   layername
   256
   (append (list (+ x 0.6875)(+ y 0.1875)z))

   0.1875
   (rtos z 2 0)
   "POINT_ELEVATION"
   0
   0
   0
   '(0 0 1)
   )))
(entmake
   (mapcar 'cons
    (list 0 7 8 62 10 40 1 2 70 71 73 210)
    (list "ATTRIB"
   "STD"
   layername
   256
   (append (list (+ x 0.6875)(- y 0.1875)z))

   0.1875
   n
   "POINT_NAME"
   0
   0
   0
   '(0 0 1)
   )))

 (entmake
   (mapcar 'cons
    (list 0 8 62)
    (list "SEQEND" layername 256)))))
    (prompt "\nProblem with Excel. Try again.")
    )
 (princ)
 )
(princ "\n Start command with PiX ...")
(princ)

~'J'~

Welcome on board, capthedrafter

Can you upload the sample drawing with this block,

better yet in A2007 format?

 

~'J'~

Hello all.

I have problems with AutoCAD. how to draw a detailed section beam quickly and correctly? , as supported beam left, center and right support which uses data from Excel or from ETABS.

Please help.

Thank you very much..,...

HOW MAKE BEAM SECTION DETAIL WITH LISP AUTOCAD

Hello all.

I have problems with AutoCAD. how to draw a detailed section beam quickly and correctly? , as supported beam left, center and right support which uses data from Excel or from ETABS.

Please help.

Thank you very much..,...