字体怎样炸开? (defun c:txtexp (/ grplst getgname blknm fltr glst gdict ss view uplft tmpfil tbx tmpfil cnt pt1 pt2 ent txt txtyp ptlst zm locked gnam vpna vplocked) (acet-error-init (list (list "cmdecho" 0 "highlight" 1 "osmode" 0 "mirrtext" 1 "limcheck" 0 ) t ) ) (defun acet-txtexp-grplst (/ grp itm nam ent glst) (setq grp (dictsearch (namedobjdict) "acad_group")) (while (setq itm (car grp)) ; while edata item is available (if (= (car itm) 3) ; if the item is a group name (setq nam (cdr itm) ; get the name grp (cdr grp) ; shorten the edata itm (car grp) ; get the next item ent (cdr itm) ; which is the ename grp (cdr grp) ; shorten the edata glst ; store the ename and name (if glst (append glst (list (cons ent nam))) (list (cons ent nam)) ) ) (setq grp (cdr grp)) ; else shorten the edata ) ) glst (defun acet-txtexp-getgname (ent glst / grp gdata nam nlst) (if (and glst (listp glst)) (progn (foreach grp glst (setq gdata (entget (car grp))) (foreach itm gdata ; step through the edata (if (and (= (car itm) 340) ; if the item is a entity name (eq (setq nam (cdr itm)) ent) ; and the ename being looked for ) (setq nlst ; store the ename and name (if nlst (append nlst (list (cons (car grp) (cdr grp)))) (list (cons (car grp) (cdr grp))) ) ) ) ) ) ) ) nlst ) ; ---------------------------------------------------------------- ; main program ; ---------------------------------------------------------------- (if (and ; are we in plan view? (equal (car (getvar "viewdir")) 0 0.00001) (equal (cadr (getvar "viewdir")) 0 0.00001) ( (caddr (getvar "viewdir")) 0) ) (progn (prompt "\nselect text to be exploded: ") (setq fltr '((-4 . " ") (-4 . " ") (-4 . "and ") ) glst (acet-txtexp-grplst) ; get all the groups in drawing gdict (if glst (dictsearch (namedobjdict) "acad_group") ) ss (ssget fltr) cnt 0 ) ;; filter out the locked layers (if ss (setq ss (car (bns_ss_mod ss 1 t))) ) ;if ;; if we have anything left (if ss (progn (setq cnt 0) ; reset counter (while (setq ent (ssname ss cnt)) ; step through each object in set (and glst ; if groups are present in the drawing (setq gnam (acet-txtexp-getgname ent glst)) ; and the text item is in one or more (foreach grp gnam ; step through those groups (command "_.-group" "_r" ; and remove the text item (cdr grp) ent "" ) ) ) (setq tbx (acet-geom-textbox (entget ent) 0)) ; get textbox points (setq tbx (mapcar '(lambda (x) (trans x 1 0) ; convert the points to wcs ) tbx ) ) (setq ptlst (append ptlst tbx)) ; build list of bounding box ; points for text items selected (setq cnt (1+ cnt)) ; get the next text item ); while (setq ptlst (mapcar '(lambda (x) (trans x 0 1) ; convert all the points ) ; to the current ucs ptlst ) ) (if (setq zm (acet-geom-zoom-for-select ptlst)) ; if current view does not contain (progn ; all bounding box points (setq zm (list (list (- (caar zm) (acet-geom-pixel-unit)) ; increase zoom area by (- (cadar zm) (acet-geom-pixel-unit)) ; one pixel width to (caddar zm) ; sure nothing will be lost ) (list (+ (caadr zm) (acet-geom-pixel-unit)) (+ (cadadr zm) (acet-geom-pixel-unit)) (caddr (cadr zm)) ) ) ) (if (setq vpna (acet-currentviewport-ename)) (setq vplocked (acet-viewport-lock-set vpna nil)) );if (command "_.zoom" "_w" (car zm) (cadr zm)) ; zoom to include text objects ) ) (setq view (acet-geom-view-points) tmpfil (strcat (getvar "tempprefix") "txtexp.wmf") pt1 (acet-geom-midpoint (car view) (cadr view)) pt2 (list (car pt1) (cadadr view)) ) (if (acet-layer-locked (getvar "clayer")) ; if current layer is locked (progn (command "_.layer" "_unl" (getvar "clayer") "") ; unlock it (setq locked t) ) ) (command "_.mirror" ss "" pt1 pt2 "_y" "_.wmfout" tmpfil ss "") (if (findfile tmpfil) ; does wmf file exist? (progn (command "_.erase" ss "") ; erase the orignal text (setq ss (acet-wmfin tmpfil)) ; insert the wmf file (command "_.mirror" ss "" pt1 pt2 "_y") ) ;progn ) ;if (if locked (command "_.layer" "_lock" (getvar "clayer") "") ; relock if needed ) ;if (if zm (command "_.zoom" "_p")) ; restore original view if needed (if vplocked (acet-viewport-lock-set vpna t) ;re-lock the viewport if needed. );if (prompt (acet-str-format "\n%1 text object(s) have been exploded to lines." cnt)) (prompt "\nthe line objects have been placed on layer 0.") ) ) ) (prompt "\nview needs to be in plan (0 0 1).") );if equal (acet-error-restore) ; retsore values (princ) ) (princ) ;加载此程序即可！执行txtexp查看更多
第1天
关注盖德视界
添加小助手
