Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

U blocks to Ascii point file

5 REPLIES 5
SOLVED
Reply
Message 1 of 6
Anonymous
863 Views, 5 Replies

U blocks to Ascii point file

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:POINTS.ASC" "a"))
    (write-line LIN F)
    (close F)
    (command ".erase" EN "")
  ) ;end while more items
) ;end UBLK.lsp

 

 

5 REPLIES 5
Message 2 of 6
pbejse
in reply to: Anonymous

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,   Smiley Happy

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

 

 

 

 

 

 

 

Message 3 of 6
Shneuph
in reply to: Anonymous

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)
Message 4 of 6
Shneuph
in reply to: Anonymous

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)
Message 5 of 6
Jeff_M
in reply to: Anonymous

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
EESignature
Message 6 of 6
Anonymous
in reply to: Jeff_M

Thanks Jeff M.

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost