Does anyone know if there's a LISP or VBA routine that will export selected text in a drawing and either allow it to be pasted into Notepad or Excel (or a TXT/CSV file)? The drawings I'm editing were not created with Blocks/Attributes and therefore I cannot use the Extract Attribute command.
(defun c:tex ( / a b c d e f g h i l r) (graphscr) (setq l (getpoint "1. Fensterpunkt :"))
(if l (setq r (getcorner l "2. Fensterpunkt :") a (ssget "_W" l r ) ; Texte im Fenster suchen keine Filterliste moeglich a (onlyent a "TEXT") ) (setq a (ssget "X" (list (cons 0 "TEXT"))) ; alle Texte suchen ) ) ; end if
(if (< 0 (sslength a)) (progn ;(prall (list "\n" (sslength a) " Elemente gefunden.\n" ))
(setq g 0 d (open "scr.scr" "w") )
; Text an Editor übergeben
(while (< g (sslength a) ) (setq h (ssname a g) e (entget h) b (feld 0 e) c (feld 1 e) ) (if (= "TEXT" b) (progn (princ (strcat c "\n") d) (setq g (1+ g)) ) ; aus Auswahlsatz entfernen (setq a (ssdel h a)) ) ) ; ende while (close d)(setq d nil)
(setq b " scr.scr")
(startapp v:editor b)
; Text von Editor übernehmen wenn dieser fertig ist ; bei Windows wegen Multitasking jetzt Programm anhalten
(getstring "\nEditor fertig ? ")
(setq f (sslength a) g 0 d (open "scr.scr" "r") ) (while (< g f) (setq e (entget (ssname a g)) c (read-line d) ; Zeile lesen ) (if (/= c (feld 1 e)) (progn (setq e (append (list (assoc -1 e)) (list (cons 1 c))) ) (setq i (entmod e)) (if (not i) (getstring "\nElement nicht nachgefuehrt!") (princ "Erfolgreich nachgefuehrt\n") ) ) ; Ende progn wenn ungleich (princ "Element gleich\n") ) ; Ende if (setq g (1+ g)) ) ; ende while (close d)(setq d nil) (redraw)(grtext) ) ; ende progn (princ "\nKeine Texte gewaehlt.\n") ) ; ende if (princ) )
( defun prall ( a / b ) ( foreach b a (princ b )) (princ ) )
(defun Onlyent ( a e / b f h i) (setq i 0) (while (< i (sslength a) ) (setq h (ssname a i) f (entget h) b (feld 0 f) ) (if (= e b) (setq i (1+ i)) ; aus Auswahlsatz entfernen (setq a (ssdel h a)) ) ) ; ende while
a )
(defun feld ( a b) (cdr(assoc a b)) )
(defun startapp ( a b / c) (setq c (strcat a " " b)) (command "Shell" c)
Je Wed, 21 Jul 2004 22:22:15 +0100, "Disco Dave" skribis:
Dave,
There's a program that I use that was written for the purpose of extracting text for translation into other languages. It then merges the translated text files with the original graphic elements to create translated drawings.
PolyTech Forum website is not affiliated with any of the manufacturers or service providers discussed here.
All logos and trade names are the property of their respective owners.