Jump to content

Extract XYZ values from multiple blocks

justindm

By justindm
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Lee Mac Grand Master

Lee Mac

Posted
Posted
not sure what link youre talking about......

 

Post#5 - program should do what you want and much, much more... :P

  • Replies 35
  • Created
  • Last Reply

Top Posters In This Topic

  • Tharwat

    12

  • alanjt

    6

  • Lee Mac

    5

  • symoin

    5

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

justindm Apprentice

justindm

Posted
  • Author
Posted

OOOOOOOOHHHHHHHHH.....DUUUUUUDE!!! :shock:

 

AWESOME!!! SO AWESOME!!!

 

Thank you!!

Lee Mac Grand Master

Lee Mac

Posted
Posted
OOOOOOOOHHHHHHHHH.....DUUUUUUDE!!! :shock:

 

AWESOME!!! SO AWESOME!!!

 

Thank you!!

 

:D Glad you like it!

 

Enjoy :)

Tharwat Grand Master

Tharwat

Posted
Posted
@Tharwat - yours works awesome! much simpler than the eattext (and much less filling :lol:)

 

Is there a way to specify the location of the output file? Or just to the same place as the dwg location?

 

You're welcome .

 

Here is one according to your request.

 

(defun c:THex (/ dir fNme ss)
 ; THARWAT 2010  
(if (and  (setq dir (getvar 'dwgprefix))
          (setq fNme (open (strcat dir "Block-coordinates.txt" ) "w"))
          (setq ss (ssget "_:L" '((0 . "INSERT"))))
        )
   (
    (lambda (i / ss1 e pt1 )
      (while
   (setq ss1
          (ssname ss (setq i (1+ i))))
     (setq e
        (entget ss1))
           (setq pt1
          (cdr (assoc 10 e)))
            
   (write-line
     (strcat  (rtos (car pt1) 2)
             "," (rtos (cadr pt1) 2)
                 ","  (rtos (caddr pt1) 2))
     fNme)
         )
      )
     -1
     )
  (princ)
  )
   (close fNme)
 (princ "\n Written by Tharwat")
 (princ)
 )

 

Enjoy. :)

Tharwat

  • 6 years later...
symoin Enthusiast

symoin

Posted
Posted
You're welcome .

 

Here is one according to your request.

 

(defun c:THex (/ dir fNme ss)
 ; THARWAT 2010  
(if (and  (setq dir (getvar 'dwgprefix))
          (setq fNme (open (strcat dir "Block-coordinates.txt" ) "w"))
          (setq ss (ssget "_:L" '((0 . "INSERT"))))
        )
   (
    (lambda (i / ss1 e pt1 )
      (while
   (setq ss1
          (ssname ss (setq i (1+ i))))
     (setq e
        (entget ss1))
           (setq pt1
          (cdr (assoc 10 e)))
            
   (write-line
     (strcat  (rtos (car pt1) 2)
             "," (rtos (cadr pt1) 2)
                 ","  (rtos (caddr pt1) 2))
     fNme)
         )
      )
     -1
     )
  (princ)
  )
   (close fNme)
 (princ "\n Written by Tharwat")
 (princ)
 )

 

Enjoy. :)

Tharwat

 

Thanks for this beautiful code....

Could you please modify to include the layer of the block (layer on which it is inserted)

Tharwat Grand Master

Tharwat

Posted
Posted
Thanks for this beautiful code....

Thank you.

 

Could you please modify to include the layer of the block (layer on which it is inserted)

Can you show how it should look like in the txt file to allow me to modify the codes with one shot if possible?

symoin Enthusiast

symoin

Posted
Posted

blk-details.jpg

 

Please find the attached it has Pointid or Sl. No, Easting, Northing, Elevation and Code.

Some can like this even without the Sl.No. will be great.

Thanks.

Tharwat Grand Master

Tharwat

Posted
Posted 
(defun c:Test (/ sel dir fil int ent get pnt)
 ;; Tharwat - Date: 03.Aug.2017	;;
 (if (and (setq sel (ssget "_:L" '((0 . "INSERT"))))
          (setq int -1
                dir (getvar 'dwgprefix))
          (setq fil (open (strcat dir "Block-coordinates.txt") "w"))
          )
   (while (setq ent (ssname sel (setq int (1+ int))))
        (setq get (entget ent)
              pnt (cdr (assoc 10 get))
              )
     (write-line (strcat (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) "," (rtos (caddr pnt) 2) "," (cdr (assoc 8 get))) fil)
     )
   )
 (if fil (close fil))
 (princ)
 )

symoin Enthusiast

symoin

Posted
Posted 
(defun c:Test (/ sel dir fil int ent get pnt)
 ;; Tharwat - Date: 03.Aug.2017	;;
 (if (and (setq sel (ssget "_:L" '((0 . "INSERT"))))
          (setq int -1
                dir (getvar 'dwgprefix))
          (setq fil (open (strcat dir "Block-coordinates.txt") "w"))
          )
   (while (setq ent (ssname sel (setq int (1+ int))))
        (setq get (entget ent)
              pnt (cdr (assoc 10 get))
              )
     (write-line (strcat (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) "," (rtos (caddr pnt) 2) "," (cdr (assoc 8 get))) fil)
     )
   )
 (if fil (close fil))
 (princ)
 )

 

Firstly I apologize for the delay and Then thanks for this code.

This works exactly as required but only one issue is its creating the list in reverse order. (newer first and older last). Can it be reversed to older first and newest last.

 

Thanks

Tharwat Grand Master

Tharwat

Posted
Posted
Firstly I apologize for the delay and Then thanks for this code.

This works exactly as required but only one issue is its creating the list in reverse order. (newer first and older last). Can it be reversed to older first and newest last.

 

Thanks

 

Its okay - you're welcome anytime.

 

Are you after sorting the list as per the smallest X coordinates?

symoin Enthusiast

symoin

Posted
Posted

not exactly,

now your code creates the list with the order of block created or inserted from newer to older into the drawing, required exactly the same with from older to newer..

 

Thanks

Tharwat Grand Master

Tharwat

Posted
Posted
not exactly,

now your code creates the list with the order of block created or inserted from newer to older into the drawing, required exactly the same with from older to newer..

 

Thanks

 

(defun c:Test (/ sel dir fil int ent get pnt)
 ;; Tharwat - Date: 03.Aug.2017	;;
 (if (and (setq sel (ssget "_:L" '((0 . "INSERT"))))
          (setq int (sslength sel)
                dir (getvar 'dwgprefix))
          (setq fil (open (strcat dir "Block-coordinates.txt") "w"))
          )
   (while (setq ent (ssname sel (setq int (1- int))))
        (setq get (entget ent)
              pnt (cdr (assoc 10 get))
              )
     (write-line (strcat (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) "," (rtos (caddr pnt) 2) "," (cdr (assoc 8 get))) fil)
     )
   )
 (if fil (close fil))
 (princ)
 )

symoin Enthusiast

symoin

Posted
Posted

Thanks,

Exactly what I was looking....

appreciate your help

Tharwat Grand Master

Tharwat

Posted
Posted
Thanks,

Exactly what I was looking....

appreciate your help

 

You're welcome.

  • 5 months later...
jgarza0422 Newbie

jgarza0422

Posted
Posted

What is need to include these attribute information?

Atttribute Data.PNG

  • 6 years later...
Vittorio Apprentice

Vittorio

Posted
Posted (edited)

Hello,

 

I found this post and it is almost exactly what I need.

 

Could someone edit the LISP code so it also shows the Block Names.

Info: All my Blocks are Anonymous Blocks (eg. *U1234).

 

What I need at the end is something like this:

Block Name | Block Rotation | Block X Scale | Block Y Scale | Block Z Scale | Easting | Northing | Height | Layer Name

*U12345,270.000,1.000,1.000,1.000,123456.789,987654.321,123.456,LayerXYZ

 

Is this possible?

 

Many thanks in advance.

 

________________________________________

This is what I figured out (without rotation and scale): 

(defun c:XList (/ sel dir fil int ent get pnt)
 ;; Tharwat - Date: 03.Aug.2017	;;
 (if (and (setq sel (ssget "_:L" '((0 . "INSERT"))))
          (setq int (sslength sel)
                dir (getvar 'dwgprefix))
          (setq fil (open (strcat dir "Block-coordinates.txt") "w"))
          )
   (while (setq ent (ssname sel (setq int (1- int))))
        (setq get (entget ent)
              pnt (cdr (assoc 10 get))
              )
     (write-line (strcat (cdr (assoc 2 get)) "," (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) "," (rtos (caddr pnt) 2) "," (cdr (assoc 8 get))) fil)
     )
   )
 (if fil (close fil))
 (princ)
 )

 

How can I get the blocks rotation and scale to output?

 

EDIT 2 (10/28/24 13:20 CET)

I finally figured it out, maybe someone will find it helpful:

  

(defun c:XList (/ sel dir fil int ent get pnt)
 (defun RtD (r) (* r 57.29577951))
 (if (and (setq sel (ssget "_:L" '((0 . "INSERT"))))
          (setq int (sslength sel)
                dir (getvar 'dwgprefix))
          (setq fil (open (strcat dir "Block-coordinates.txt") "w"))
          )
   (while (setq ent (ssname sel (setq int (1- int))))
        (setq get (entget ent)
              pnt (cdr (assoc 10 get))
              )
	 (write-line (strcat 
					(cdr (assoc 2 get)) "," 
					(rtos (RtD (cdr (assoc 50 get)))) "," 
					(rtos (cdr (assoc 41 get))) "," 
					(rtos (cdr (assoc 42 get))) "," 
					(rtos (cdr (assoc 43 get))) "," 
					(rtos (car pnt) 2) "," 
					(rtos (cadr pnt) 2) "," 
					(rtos (caddr pnt) 2) "," 
					(cdr (assoc 8 get))
				 ) fil)
;(write-line (strcat (cdr (assoc 2 get)) "," (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) "," (rtos (caddr pnt) 2) "," (cdr (assoc 41 get))) fil)
;      (write-line (strcat (cdr (assoc 2 get)) "," (cdr (assoc 50 get)) "," (cdr (assoc 41 get)) "," (cdr (assoc 42 get)) "," (cdr (assoc 43 get)) "," (rtos (car pnt) 2) "," (rtos (cadr pnt) 2) "," (rtos (caddr pnt) 2) "," (cdr (assoc 8 get))) fil)
     )
   )
 (if fil (close fil))
 (princ)
 )

 

 

 

Edited by Vittorio
solved by myself

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...