[求助]文字分解的问题？

shaowei

(defun c:xt (/ bz ss n lvs lss lvp lvl lul ent luu)
(prompt "\n文字分解")
(while (setq ss (ssget ":S" '((0 . "*text"))))
(setvar "cmdecho" 0) (command "undo" "be") (setvar "mirrtext" 1)
(command "zoom" "e")
(setq bz (getvar "osmode")) (setvar "osmode" 0)
(setq lvs (getvar "viewsize") lss (getvar "screensize") lvp (getvar "viewctr")
      lvl (list (list (- (car lvp) (* 0.5 (* lvs (/ (car lss) (cadr lss))))) (- (cadr lvp) (* 0.5 lvs)))
                   (list (+ (car lvp) (* 0.5 (* lvs (/ (car lss) (cadr lss))))) (+ (cadr lvp) (* 0.5 lvs))))
          lul (list (caar lvl) (cadadr lvl)) n 0)
(repeat (sslength ss)
  (setq ent (ssname ss n))
  (setq luu (strcat (getenv "Temp") "\\textb.wmf"))
  (command "mirror" ent "" lvp "@0,1" "y"
  "wmfout" luu ent "" "erase" ent ""
  "wmfin" luu lul "2" "" ""
  "mirror" (entlast) "" lvp "@0,1" "y"
  "explode" (entlast) "erase" (ssget "p") "r" "w"
  (polar (car lvl) (* 0.25 pi) (max (abs (/ lvs (cadr lss))) (abs (/ (* lvs (/ (car lss) (cadr lss))) (car lss)))))
  (cadr lvl) "") ;;end_command
  (setq n (+ n 1))
)
(command "zoom" "p")
(setvar "mirrtext" 0) (setvar "osmode" bz) (command "undo" "e")
(vl-file-delete luu)
)
(princ)
)

shaowei

(defun c:xt (/ bz ss n lvs lss lvp lvl lul ent luu)
(prompt "\n文字分解")
(while (setq ss (ssget ":S" '((0 . "*text"))))
(setvar "cmdecho" 0) (command "undo" "be") (setvar "mirrtext" 1)
(command "zoom" "e")
(setq bz (getvar "osmode")) (setvar "osmode" 0)
(setq lvs (getvar "viewsize") lss (getvar "screensize") lvp (getvar "viewctr")
      lvl (list (list (- (car lvp) (* 0.5 (* lvs (/ (car lss) (cadr lss))))) (- (cadr lvp) (* 0.5 lvs)))
            (list (+ (car lvp) (* 0.5 (* lvs (/ (car lss) (cadr lss))))) (+ (cadr lvp) (* 0.5 lvs))))
   lul (list (caar lvl) (cadadr lvl)) n 0)
(repeat (sslength ss)
  (setq ent (ssname ss n))
  (setq luu (strcat (getenv "Temp") "\\textb.wmf"))
  (command "mirror" ent "" lvp "@0,1" "y"
  "wmfout" luu ent "" "erase" ent ""
  "wmfin" luu lul "2" "" ""
  "mirror" (entlast) "" lvp "@0,1" "y"
  "explode" (entlast) "erase" (ssget "p") "r" "w"
  (polar (car lvl) (* 0.25 pi) (max (abs (/ lvs (cadr lss))) (abs (/ (* lvs (/ (car lss) (cadr lss))) (car lss)))))
  (cadr lvl) "") ;;end_command
  (setq n (+ n 1))
)
(command "zoom" "p")
(setvar "mirrtext" 0) (setvar "osmode" bz) (command "undo" "e")
(vl-file-delete luu)
)
(princ)
)

不怎么完善，有空也帮我优化一下

hyccai

改天我上个比较复杂的代码

luyu9635

大家可以看看陈伯雄老师的代码,如下:

(Defun C:TextB (/ lvl lul lvp lvs lss ViewPL)
       ;(SetIErr)
       (SetQ lvs (GetVar "viewsize")
             lss (GetVar "screensize")
       )
       (Defun ViewPL ( / vi vw vh vc)
              (setq vi (* lvs (/ (Car lss) (Cadr lss)))
                    vc (GetVar "viewctr")
                    vw (list (- (car vc)  (* 0.5 vi))
                             (- (cadr vc) (* 0.5 lvs))
                       )
                    vh (list (+ (car vc)  (* 0.5 vi))
                             (+ (cadr vc) (* 0.5 lvs))
                       )
              )
              (List vw vh)
       )
       (PrinC "\nÇëÑ¡ÔñÒª·Ö½âµÄÎÄ×Ö: ")
       (SetQ ltl (SSGet)
             lvl (ViewPL)
             lul (List (Caar lvl) (Cadadr lvl))
             lvp (GetVar "viewctr")
       )
       (Command "mirror" ltl "" lvp "@0,1" "y"
                "wmfout" "textb" ltl ""
                "erase" ltl ""
                "wmfin" "textb" lul "2" "" ""
                "mirror" (EntLast) "" lvp "@0,1" "y"
                "explode" (EntLast)
                "erase" (ssget "p") "R" "W"
                        (polar (car lvl) (* 0.25 Pi)
                               (Max (Abs (/ lvs (Cadr lss)))
                                    (Abs (/ (* lvs
                                               (/ (Car lss) (Cadr lss))
                                            )
                                            (Car lss)
                                         )
                                     )
                               )
                        )
                        (cadr lvl)
                    ""
       )
       ;(ReErr)
  (PrinC)
)

qing6688

(defun c:xt() (princ "txtexp") (command (c:txtexp)))

我也在其他地方找到的，并非原创！

caoyin

vocabulary发表于2006-8-1 0:32:00我用4楼大侠的方法试了一下,将输出的的WMF文件插入后,用X命令炸不开,不知是怎么回事?请各位帮忙看看,先谢谢了!

对于TTF字体，需要设置为反向(镜像一下)，然后再WMFOUT，WMFIN