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
Solved! Go to Solution.
Solved by Jeff_M. Go to Solution.
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,
show us the final product (i.e coints.asc) then we can work out something. or maybe we can re-write the whole thing,
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...
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
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)