[编程交流] 将文字从autocad导出到ex

(defun c:tsel (/ ss lst tss olst ofile)
(vl-load-com)
(if (setq ss (ssget '((0 . "*TEXT"))))
(progn
(setq lst
(mapcar
(function
(lambda (x)
(vla-get-TextString
(vlax-ename->vla-object x))))
(vl-remove-if 'listp
(mapcar 'cadr (ssnamex ss)))))
(foreach str (unique lst)
(if (setq tss
(ssget "_X"
(list '(0 . "*TEXT") (cons 1 str))))
(setq olst
(cons
(cons str (sslength tss)) olst))
(setq olst
(cons
(cons str 0.) olst))))
(setq ofile
(open
(strcat
(getvar "DWGPREFIX")
(substr
(getvar "DWGNAME") 1
(- (strlen
(getvar "DWGNAME")) 4)) "-StrCnt.txt") "a"))
(mapcar
(function
(lambda (x)
(write-line
(strcat (car x) "\t"
(vl-princ-to-string (cdr x))) ofile))) olst)
(close ofile)
(princ "\n<< Strings Written to File >>"))
(princ "\n<< Nothing Selected >>"))
(princ))
;; CAB
(defun unique (lst / result)
(reverse
(while (setq itm (car lst))
(setq lst (vl-remove itm lst)
result (cons itm result)))))

[color=GREEN];; Text Extraction  -  Lee Mac[/color]
[color=GREEN];; Extracts all Text & MText in Modelspace to a Text file,[/color]
[color=GREEN];; with the number of occurrences of each string.[/color]
([color=BLUE]defun[/color] c:txtext ( [color=BLUE]/[/color] a d f i l s x )
   ([color=BLUE]cond[/color]
       (   ([color=BLUE]not[/color] ([color=BLUE]setq[/color] s ([color=BLUE]ssget[/color] [color=MAROON]"_X"[/color] '((0 . [color=MAROON]"*TEXT"[/color]) (410 . [color=MAROON]"Model"[/color])))))
           ([color=BLUE]princ[/color] [color=MAROON]"\nNo Text or MText found in Modelspace."[/color])
       )
       (   ([color=BLUE]not[/color] ([color=BLUE]setq[/color] f ([color=BLUE]getfiled[/color] [color=MAROON]""[/color] [color=MAROON]""[/color] [color=MAROON]"txt"[/color] 1)))
           ([color=BLUE]princ[/color] [color=MAROON]"\n*Cancel*"[/color])
       )
       (   ([color=BLUE]setq[/color] d ([color=BLUE]open[/color] f [color=MAROON]"w"[/color]))
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
               ([color=BLUE]setq[/color] x ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 1 ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] s ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i)))))))
               ([color=BLUE]if[/color] ([color=BLUE]setq[/color] a ([color=BLUE]assoc[/color] x l))
                   ([color=BLUE]setq[/color] l ([color=BLUE]subst[/color] ([color=BLUE]cons[/color] x ([color=BLUE]1+[/color] ([color=BLUE]cdr[/color] a))) a l))
                   ([color=BLUE]setq[/color] l ([color=BLUE]cons[/color]  ([color=BLUE]cons[/color] x 1) l))
               )
           )
           ([color=BLUE]foreach[/color] x ([color=BLUE]vl-sort[/color] l '([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]<[/color] ([color=BLUE]car[/color] a) ([color=BLUE]car[/color] b))))
               ([color=BLUE]write-line[/color] ([color=BLUE]strcat[/color] ([color=BLUE]car[/color] x) [color=MAROON]"\t"[/color] ([color=BLUE]itoa[/color] ([color=BLUE]cdr[/color] x))) d)
           )
           ([color=BLUE]close[/color] d)
       )
       (   ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nUnable to write to "[/color] f))   )
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]princ[/color])

(alert 
"here i can write the text"
)

([color=BLUE]not[/color] ([color=BLUE]setq[/color] f ([color=BLUE]getfiled[/color] [color=MAROON]""[/color] [color=MAROON]""[/color] [color=MAROON]"txt"[/color] 1)))

([color=BLUE]not[/color] ([color=BLUE]setq[/color] f ([color=BLUE]getfiled[/color] [color=MAROON]""[/color] [color=MAROON]""[/color] [color=MAROON]"txt"[/color] 1)))

(not (setq f (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)) ".txt")))