Visual LISP, AutoLISP and General Customization

Reply
*Expert Elite*
azrdgldr
Posts: 1,250
Registered: ‎01-09-2007
Message 1 of 6 (321 Views)
Accepted Solution

U blocks to Ascii point file

321 Views, 5 Replies
07-15-2011 04:09 AM

Stumped on this one.  I created a lisp program years ago to convert some blocks to an ascii point file.  Now I have been asked to convert these U blocks into the same thing.  I know the text in these blocks are mtext and not attributes.  I have tried the (entget (entnext item)) at the prompt and I am not getting what I expect.  I know I am missing or forgetting something.  I have attached a sample dwg (2004) with some blocks and what code I have.  Can someone help or jog my memory.  Thanks for your help on this.

 

 

(defun C:UBLK (/ ITEMS i EN ED XYZ EST NOR ELV ENA ENAL PTN ENB ENBL DSC LIN F)
  (command "UNDO" "mark") ;undo mark
  (prompt "Select Items: ")
  (setq ITEMS (ssget)) ;select items
  (setq i (sslength ITEMS)) ;counter
    (while (> i 0) ;while items left
    (setq i (1- i)) ;decrement counter
    (setq EN (ssname ITEMS i)) ;get name
      (if (= (cdr (assoc 0 EN)) "INSERT")
      
    (setq ED (entget EN)) ;entity info
    (setq XYZ (cdr (assoc 10 ED)))
    (setq EST (rtos (car XYZ) 2 6))
    (setq NOR (rtos (cadr XYZ) 2 6))
    (setq ELV (rtos (last XYZ) 2 4))


    (setq ENA (entnext EN))
    (setq ENAL (entget ENA))
    (setq PTN (cdr (assoc 1 ENAL)))
    (setq ENB (entnext ENA))
    (setq ENBL (entget ENB))
    (setq DSC (cdr (assoc 1 ENBL)))

    (setq LIN (strcat PTN "," NOR "," EST "," ELV "," DSC))
    (princ LIN)
    (setq F (open "C:smileytongue:OINTS.ASC" "a"))
    (write-line LIN F)
    (close F)
    (command ".erase" EN "")
  ) ;end while more items
) ;end UBLK.lsp

 

 

*Expert Elite*
pbejse
Posts: 2,432
Registered: ‎11-24-2009
Message 2 of 6 (317 Views)

Re: U blocks to Ascii point file

07-15-2011 05:39 AM in reply to: azrdgldr

there are few errors onthe code itself

 

because you're doing the ENTNEXT method the wrong way....

(= (cdr (assoc 0  EN)) "INSERT") this line will crash

 

Also, running the IF fucntion requires one THEN and an  ELSE  (optional), if invoking a multiple THEN use

(if (true statement)

(progn

      (argument1...)(argument2...)

);progn

ELSE

);if

 

to be honest i'm just lazy to try the code,   :smileyhappy:

 show us the final product (i.e coints.asc) then we can work out something. or maybe we can re-write the whole thing,

 

 

 

 

 

 

 

Valued Mentor
Shneuph
Posts: 318
Registered: ‎11-26-2007
Message 3 of 6 (311 Views)

Re: U blocks to Ascii point file

07-15-2011 06:51 AM in reply to: azrdgldr

I believe that the (entnext) method after finding your block reference only returns attributes which is why you can't get the MTEXT objects from your block.  You would have to get the block reference object and then look inside it for the mtext objects...

 

I haven't tried this but I will and will post something a little later...

---sig---------------------------------------
'(83 104 110 101 117 112 104 64 71 109 97 105 108 46 99 111 109)
Valued Mentor
Shneuph
Posts: 318
Registered: ‎11-26-2007
Message 4 of 6 (309 Views)

Re: U blocks to Ascii point file

07-15-2011 07:12 AM in reply to: azrdgldr

This should get you pointed in the right direction.  You can modify it to suite your needs...

 

You can replace (princ (strcat "\nMtext Item String: " (vla-get-textstring item))) with your code to export the string to a file.

 

(defun ExportBlocksMtext (blockname /)
(vl-load-com)
(setq blockname (strcase blockname)) (vlax-for block (setq blocks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) (if (= (strcase (vla-get-name block)) blockname) (progn (vlax-for item block (if (= (vla-get-objectname item) "AcDbMText") (progn (princ (strcat "\nMtext Item String: " (vla-get-textstring item))) );progn );if );vlax-for );progn );if );vlax-for (princ) );defun

 

---sig---------------------------------------
'(83 104 110 101 117 112 104 64 71 109 97 105 108 46 99 111 109)
*Expert Elite*
Jeff_M
Posts: 4,194
Registered: ‎07-22-2003
Message 5 of 6 (302 Views)

Re: U blocks to Ascii point file

07-15-2011 08:01 AM in reply to: azrdgldr

This should work for you.

(defun C:UBLK (/ ITEMS i EN ED XYZ EST NOR ELV ENA ENAL	PTN ENB	ENBL 
	       LIN F)
  (command "UNDO" "mark")		;undo mark
  (prompt "Select Items: ")
  (if (setq ITEMS (ssget '((0 . "INSERT") (2 . "`*U*")))) ;select items
    (progn
      (setq F (open "C:\\temp\\POINTS.ASC" "a"))

      (setq 
	    i (sslength ITEMS))		;counter
      (while (> i 0)			;while items left
	(setq i (1- i))			;decrement counter
	(setq EN (ssname ITEMS i))	;get name
	(SETQ TXTLST nil)

	(setq ED (entget EN))		;insert info
	(setq XYZ (cdr (assoc 10 ED)))
	(setq EST (rtos (car XYZ) 2 6))
	(setq NOR (rtos (cadr XYZ) 2 6))
	(setq ELV (rtos (last XYZ) 2 4))
	(setq bname (cdr (assoc 2 ed)))
	(setq ena (tblobjname "BLOCK" bname))
	(while (setq ENA (entnext ena))
	  (setq ENAL (entget ENA))
	  (if (eq (cdr (assoc 0 enal)) "MTEXT")
	    (setq txtlst (cons (list (cadr (cdr (assoc 10 enal))) (cdr (assoc 1 enal))) txtlst))
	    )
	  )
	;;sort the MTEXT values by Y value. To ensure output order of
	;; PNT
	;; ELEV
	;; DESC
	(setq txtlst (vl-sort txtlst '(lambda (a b)
				 (> (car a) (car b))
				 )
			      ))	
	
	(setq LIN (strcat (cadar txtlst) "," NOR "," EST "," (cadadr txtlst) "," (cadr (last txtlst))))
	;;(princ txt)
	(write-line LIN F)
      )

      (close F)

      (command ".erase" items "") ;;what if other Anonymous blocks are selected????
      )
    )
  )
					;end UBLK.lsp

 

 edited for mislplaced (setq txtlst nil)

Jeff_M, also a frequent Swamper
*Expert Elite*
azrdgldr
Posts: 1,250
Registered: ‎01-09-2007
Message 6 of 6 (290 Views)

Re: U blocks to Ascii point file

07-15-2011 09:17 AM in reply to: Jeff_M

Thanks Jeff M.

You are not logged in.

Log into access your profile, ask and answer questions, share ideas and more. Haven't signed up yet? Register

Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.

Need installation help?

Start with some of our most frequented solutions to get help installing your software.

Ask the Community