[LISP程序]：大虾们急救！怎样将原来的style改变成新的style!!万分感谢！

petertian

众大虾，我的图内原来只有四种text style，分别为standard,monotxt,bigfont,cctxt四种，现要在R14下用autolisp编程将其按照层色和大小选择出来变成fftxt,dxt,htext,ccetxt,bbetxt,hugetxt,fghtxt等20余种text style,我该怎样写出代码！！！含泪感谢！！！！

lsjjm

REFER TO THIS CODE:

(defun changetextstyle ()
    (setq chm 0 p (ssget))
    (if p (progn
              (setq cont t)
              (while cont
                  (setq osl (strlen (setq os (getstring "\nOld string: " t))))
                  (if (= osl 0)
                      (princ "Null input invalid")
                      (setq cont nil)
                  )
              )
              (setq nsl (strlen (setq ns (getstring "\nNew string: " t))))
              (setq l 0 n (sslength p))
              (while (< l n)
                     (if (= "TEXT"
                             (cdr (assoc 0 (setq e (entget (ssname p l))))))
                             (progn
                                 (setq chf nil si 1)
                                 (setq s (cdr (setq as (assoc 1 e))))
                                 (while (= osl (setq sl (strlen (setq st (substr s si osl)))))
                                        (if (= st os)
                                            (progn
                                                (setq s (strcat (substr s 1 (1- si)) ns (substr s (+ si osl))))
                                                (setq chf t)
                                                (setq si (+ si nsl))
                                            )
                                            (setq si (1+ si))
                                        )
                                 )
                                 (if chf (progn
                                             (setq e (subst (cons 1 s) as e))
                                             (entmod e)
                                             (setq chm (1+ chm))
                                          )
                                 )
                             )
                     )
                     (setq l (1+ l))
              )
          )
    )
    (terpri)
)

f5612140

樓主應提供原文字STYLE及所在圖層如何對應新的STYLE及字體,才能在程序設計中一次搞定

petertian

各位大虾：我现在要在R14下用autolisp写一段代码，具体要求：将图内51212层汉字的宋体改为隶书，且style原来为monotxt现在改为ccctxt；将10401层汉字的方正水柱简体改为宋体，且style原来为bigfont改为mapname；将10403层汉字的方正水柱简体改为仿宋，且将style原来为bigfont改为cttttxt。我该怎样写这段代码？随贴附上原图ttt.dwg(14版本)

petertian

(defun c:chgt1()
   (setq ss (ssget "x" (list (cons 8 "10801")(cons 0 "text"))))
   (if ss
      (progn
         (princ "\nPlease wait...")
         (setq n 0 m (sslength ss))
         
         (while (< n m)
            (setq entname (ssname ss n))
            (setq enttbl (entget entname))
            (princ "\n")
            (setq txt (cdr(assoc 1 enttbl)));;文字
            (setq tt (cdr (assoc 40 enttbl)));;文字高度
            (setq styname "mapname")
            ;(setq ttn 6)
            (setq ttn 3.0)
            ;(setq by 1)
            ;(setq qx -15)
            (setq enttbl (subst (cons 40 ttn) (assoc 40 enttbl ) enttbl ))
            ;(setq enttbl (subst (cons 41 by) (assoc 41 enttbl ) enttbl ))
            ;(setq enttbl (subst (cons 51 qx) (assoc 51 enttbl ) enttbl ))         
            ;(setq ziti "simli")
            ;(setq enttbl (subst (cons 40 ttn) (assoc 40 enttbl ) enttbl ))
            (setq enttbl (subst (cons 7 styname) (assoc 7 enttbl ) enttbl ))
            ;(setq enttbl (subst (cons 3 ziti) (assoc 3 enttbl ) enttbl ))
            ;(setq xianxing "txt");;;线型定义
            ;(setq enttbl (subst (cons 6 xianxing) (assoc 6 enttbl ) enttbl ));;;线型定义
            (princ "\n")
            (entmod enttbl)
            (entupd entname)         
            (setq n (+ 1 n))                     
         )
      )
      
   )
   (command "_.style" "mapname" "黑体" "" "" "" "" "" "")
   (princ)   
)

lsjjm

再来个简单的:

(defun c:test ()
  (vl-load-com)
  (setq ss (ssget '((0 . "*TEXT"))))
  (setq n 0)
  (while (< n (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss n)))
    (vla-put-stylename obj "standard")
    (setq n (1+ n))
    )
)