Export all Text to DWG

Export all Text to DWG

renanemeyer
Advocate Advocate
1,839 Views
11 Replies
Message 1 of 12

Export all Text to DWG

renanemeyer
Advocate
Advocate

Hello everyone!

 

I've seen many ways to export "autocad text" to *.txt or excel files, but I would like to know if there is a way (I haven't found a resolved post of this), a lisp that get all the text from the file and exports it to a new dwg, keeping the same point reference (0,0,0) ?

0 Likes
Accepted solutions (2)
1,840 Views
11 Replies
Replies (11)
Message 2 of 12

renanemeyer
Advocate
Advocate

Or if possible (that's what I've been trying to develop, export everything from a specific layer :layer called export-lay) to a new dwg, keeping 0,0,0 as a reference

0 Likes
Message 3 of 12

pendean
Community Legend
Community Legend
WBLOCK command not an option? That's its main primary task, creating a DWG file from content you isolate/select.
Message 4 of 12

hak_vz
Advisor
Advisor

Why not using command QSELECT (or through menus  tools -> guickselect > multiple -> layer) .... copy and paste to original coordinates into new drawing.

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Message 5 of 12

Kent1Cooper
Consultant
Consultant

As if you need another possible approach....

 

Turn off all Layers with the Text you want, or if that's not viable with your Layering setup, Use HIDEOBJECTS to hide all the Text you want.  ERASE everything else (!) [temporarily, of course].  Turn back on or un-hide the Text parts.  SAVE to another drawing [not QSAVE or any so-called "Save" icon that really gets you QSAVE, and not SAVEAS].  That will make another drawing just like the current state of the present one, but will leave you in the present one.  UNDO the ERASE-ing.

 

An advantage [or possibly a disadvantage, depending on your purpose] of the SAVE approach:  The resulting drawing will have all the Layers, Text and Dimension and Mleader and other Styles, Block definitions, loaded Linetypes, Limits, Layouts, Viewports, etc. of the present drawing [just no drawn content other than the Text], which will not necessarily always be the case with either the Copy/Paste or WBLOCK approaches.

Kent Cooper, AIA
Message 6 of 12

renanemeyer
Advocate
Advocate

Thanks @pendean (I liked this command, I didn't know it, it includes for testing)

Thanks @Kent1Cooper , I did something similar to your idea (I selected only the texts and isolated the layer as they will always be on the same layer), but I can't export (I'd like to export to just pass this layer to a new file, instead of passing the others hidden together )

 

(defun c:layexp (/ aDoc name)
(setvar 'Clayer "0")
(setq sel (ssget "_X" '((0 . "*TEXT"))))
(command LAYISO)
(command WBLOCK...???

0 Likes
Message 7 of 12

Kent1Cooper
Consultant
Consultant
Accepted solution

@renanemeyer wrote:

.... (I'd like to export to just pass this layer to a new file, instead of passing the others hidden together )

 

(defun c:layexp (/ aDoc name)
(setvar 'Clayer "0")
(setq sel (ssget "_X" '((0 . "*TEXT"))))
(command LAYISO)
(command WBLOCK...???


Put just this much in at the command line:

(command "_.wblock")

to see what the no-dialog-box prompt sequence will be, for filling out the rest of your command.  It would use the contents of your sel variable, provided they're all in the current space for object selection to see them.  [That's another advantage of the SAVE approach over WBLOCK or Copy/Paste -- you could have Text objects in model space and any number of paper space layouts, and it would all transfer.]  The setting Layer 0 current and LAYISO are unnecessary.

Kent Cooper, AIA
Message 8 of 12

renanemeyer
Advocate
Advocate

 Understood! Thank you very much, this way it worked perfectly @Kent1Cooper 

0 Likes
Message 9 of 12

hak_vz
Advisor
Advisor
Accepted solution

This maybe is not directly what you ask but here how it works.

Before usage, save a file under new name to retain safety copy.

Function remove_unnecessary_layers shows dialog with all layers in a drawing. You can select one or more layers you want to remove. This will empty and remove all layers you don't need. After you run the function just run purge once or more to clean the drawing.

Its not thoroughly tested so beware and work on safety copy.

 

(defun c:remove_unnecessary_layers 
	(/ adoc collectLayerObjects getlayerObject  getlayernames LM:listbox unfreezeLayer unlockLayer string_to_list
	  all_layers export_layers clayer ss i
	)
	(defun *error* (msg)
	(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))
		(progn
		   (princ (strcat "\nOops an Error : ( " msg " ) occurred."))
		)
	)
	(if (and adoc) (vla-endundomark adoc))
	(princ)
	)
	(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
	(defun collectLayerObjects ( / ret) (reverse (vlax-for lay (vlax-get (vla-get-activedocument (vlax-get-acad-object)) 'Layers) (setq ret (cons (cons (vlax-get lay 'Name) lay)ret)))))
	(defun getlayernames nil (mapcar 'car (collectLayerObjects)))
	(defun getlayerObject (layername) (cdr(assoc layername (collectLayerObjects))))
	(defun unfreezeLayer (layername / lay) (if (setq lay(getlayerObject layername))(vlax-put lay 'Freeze 0)))
	(defun unlockLayer (layername / lay) (if (setq lay(getlayerObject layername))(vlax-put lay 'Lock 0)))
	(defun string_to_list ( str del / pos )
        (if (setq pos (vl-string-search del str))
            (cons (substr str 1 pos) (string_to_list (substr str (+ pos 1 (strlen del))) del))
            (list str)
        )
    )  
	(defun LM:listbox ( msg lst bit / dch des tmp rtn )
	(cond
		(   (not
				(and
					(setq tmp (vl-filename-mktemp nil nil ".dcl"))
					(setq des (open tmp "w"))
					(write-line
						(strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select="
							(if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}"
						)
						des
					)
					(not (close des))
					(< 0 (setq dch (load_dialog tmp)))
					(new_dialog "listbox" dch)
				)
			)
			(prompt "\nError Loading List Box Dialog.")
		)
		(   t     
			(start_list "list")
			(foreach itm lst (add_list itm))
			(end_list)
			(setq rtn (set_tile "list" "0"))
			(action_tile "list" "(setq rtn $value)")
			(setq rtn
				(if (= 1 (start_dialog))
					(if (= 2 (logand 2 bit))
						(read (strcat "(" rtn ")"))
						(mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
					)
				)
			)
		)
	)
	(if (< 0 dch)
		(unload_dialog dch)
	)
	(if (and tmp (setq tmp (findfile tmp)))
		(vl-file-delete tmp)
	)
	rtn
	)
	(vla-endundomark adoc) 
    (vla-startundomark adoc) 
	(initget "Yes No")
	(if (and (eq (getkword "\nDid you make copy of this file, Do you wish to continue? [Yes/No] <No>: ") "Yes"))
		(progn
			(setq all_layers (getlayernames))
			(setq export_layers (LM:listbox "Select one or layers to retain in drawing" (getlayernames) 1))
			(setq clayer (getvar 'clayer))
			(foreach layer all_layers
				(cond
					(
						(not (member layer export_layers))
						(if (not (= layer clayer))(unfreezeLayer layer))
						(unlockLayer layer)
						(setq ss (ssget "X" (list (cons 8 layer))))
						(cond
							((and ss)
								(setq i -1)
								(while (< (setq i (1+ i)) (sslength ss))
									(entdel (ssname ss i))
								)
							)
						)
					)
				)
			)
		)
	)
	(vla-endundomark adoc)
    (princ "\nRun command Purge once or more time to clean the drawing!")
	(princ "\nDone!")	
	(princ)
)
(vl-load-com)

 

 

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Message 10 of 12

renanemeyer
Advocate
Advocate

 Very good @hak_vz 
The development of this lisp was very good, I go to adapt it for my use.
Congratulations on this development!

0 Likes
Message 11 of 12

hak_vz
Advisor
Advisor

@renanemeyer  I'm glad to be of help!

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
0 Likes
Message 12 of 12

pbejse
Mentor
Mentor

@renanemeyer wrote:

Or if possible (that's what I've been trying to develop, export everything from a specific layer :layer called export-lay) to a new dwg, keeping 0,0,0 as a reference


(defun c:TextToDwg ( / ListBoxDia CDiaStr DwgTempalte aDoc dwgn CopyToList  DwgTemplate
		          sel Exported layerlst dbxApp i TheFinalFrontier _thisDCL)  
;;;			pBe Aug 2021				;;;
(defun ListBoxDia  (Tdcl Title Lst / StrDIA flag el)
	            (setq StrDIA (load_dialog Tdcl))
	            (if (not (new_dialog "ListBoxPH" StrDIA))
	                  (exit)
	                  )
	            (start_list "StrListS")
	            (mapcar 'add_list Lst)
	            (end_list)
	            (set_tile "Base" Title)
	            (action_tile "StrListS" "(setq el (get_tile $key))")
	            (action_tile "accept" "(done_dialog 1)")
	            (action_tile "cancel" "(done_dialog 0)")
	            (setq flag (start_dialog))
	            (unload_dialog StrDIA)
  			(if (= flag 1) (read (strcat "(" el ")"))) 
	            )

(defun CDiaStr  (/ fnSTR StrDiaFnme)
            (setq StrDiaFnme (vl-filename-mktemp "tmp.DCL"))
            (setq fnSTR (open StrDiaFnme "a"))
            (write-line
                  "dcl_settings : default_dcl_settings { audit_level = 3; }
		  ListBoxPH : dialog 
		  { label = \"\"; key= \"Base\";
		  : list_box { key = \"StrListS\"; multiple_select =
		  true; width = 40; height = 20; } spacer ;
		  ok_cancel;
		  }"              fnSTR)
            (close fnSTR)
  		StrDiaFnme	
            )
  
  
(setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object))
      dwgn (vl-filename-base (vla-get-name aDoc))
	        CopyToList nil)
    
(setq DwgTemplate
       (strcat (getenv "TemplatePath")
	 (if (zerop (getvar 'Measurement))
	   "\\acad.dwt"
	   "\\acadiso.dwt"
		 )
	       )
	    )
(if
  (and
     (setq sel (ssget "_X" '((0 . "*TEXT")(410 . "Model"))))
     (setq Exported (getfiled "\nEnter drawing name"
			(strcat (getvar 'dwgprefix)  dwgn "_Text") "dwg" 1)
	       )     
     )
  (progn
	(repeat (setq i (sslength sel))
	  (setq e (vlax-ename->vla-object (ssname sel (setq i (1- i))))
	  	layer (vla-get-layer e))
	  (if (not (member layer layerlst))
		   (setq layerlst (cons layer layerlst)))
	  (setq CopyToList (cons (list layer e) CopyToList))
	  )
    	(setq layerlst (acad_Strlsort layerlst)
	       _thisDCL (CDiaStr))
    	

    (if
      (and
	(setq layersToProcess (ListBoxDia _thisDCL "List layers with TEXT/MTEXT object(s)" layerlst))
    	(setq layersToProcess (mapcar '(lambda (k) (nth k layerlst)) layersToProcess))
	(setq CopyToList (vl-remove-if-not
				   '(lambda (l)
					 (member (car l) layersToProcess)) CopyToList))
	(vl-file-delete _thisDCL)
      		)
      	(progn	  	
		(setq dbxApp
		    (if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
		        (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
		        (vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))
		    )
		)
		(vl-file-copy  DwgTemplate Exported)    
	    	(if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list dbxApp (findfile Exported)))))
			(progn
			    (setq TheFinalFrontier(vla-get-ModelSpace dbxApp))
			    (vlax-invoke aDoc 'CopyObjects (mapcar 'cadr CopyToList) TheFinalFrontier)
			    (princ (strcat "\n" (itoa (length CopyToList)) " Object(s) exported "))
			    (vla-saveas dbxApp Exported)
			    )
		  )    
	  (vlax-release-object dbxApp)
    		)
  	)
    )
  )
(princ)
)

HTH

 

0 Likes