[求助]：sos!紧急救援！

pipi002004 · 发表于 2005-11-2 17:14:08

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

大家好，这时一个tssd里面的程序子块
也是我用得比较顺手的一个子块，他的具体作用是编辑任何文字包括块里的，由于是直接反编译过来的，大家能不能帮忙把他的有些东西补齐啊，有些变量没定义。我谢谢大家了！
大家改好了的话我就集合一下，把我这2年在r14用得顺手的东西（已经全部调试完毕，好用）
以及（最近我整理天正3.0的快捷命令，tssd命令，纯r14扩展命令，注意：3个acad.pgp是通用的，还有我自己打的说明，及全部补丁邮寄送给帮助过我的人）

[FONT=courier new]
(defun c:tybj (/ en ent entl i l len na str str1 str2 tx txt wzxgtxt flag e el
enl)
(defun wzxgtxt (name / a p0 st #doret mdcl str)
(defun #doret (/ tf l i ni n1 f)
(setq na (get_tile "na"))
(if (read na)
(progn
(if (and (= (get_tile "tg") "1")
(wcmatch na "*[dDfF][1-9]*")
)
(progn
(setq l ""
n1 (substr na 1 1)
i 2
flag 1
)
(while (< i (1+ (strlen na)))
(setq ni (substr na i 1)
i (1+ i)
)
(cond
((and (= n1 "d")
(wcmatch ni "[1-9]")
)
(setq n1 "%%130")
)
((and (= n1 "D")
(wcmatch ni "[1-9]")
)
(setq n1 "%%131")
)
((and (= n1 "f")
(wcmatch ni "[1-9]")
)
(setq n1 "%%132")
)
((and (= n1 "F")
(wcmatch ni "[1-9]")
)
(setq n1 "%%133")
)
(t
nil
)
)
(setq l (strcat l n1)
n1 ni
)
)
(setq na (strcat l (substr na (strlen na) 1)))
)
)
)
(setq na nil)
)
(done_dialog 1)
)
(defun mdcl (/ hi f li na)
(if (new_dialog "wzxg" (@dcl "tssdtxt"))
(progn (set_tile "na" name)
(mode_tile "na" 2)
(action_tile
"li"
"(set_tile "na" (nth (atoi $value) li))"
)
(action_tile "help" "(help "tssd.hlp" "tybj")")
(action_tile "accept" "(#doret)")
(start_dialog)
)
)
(if na
(cons na hi)
)
)
(setq st (mdcl))
(&end "文字" t)
(&p2l "钢筋")
(if st
(setq str (car st))
(setq str name)
)
str
)
(if (< (&swap) 0)
(exit)
)
(setq ent 1)
(while ent
(setq ent (nentsel "\n选取要修改的文字对象<退出>: ")
str1 ""
str2 ""
tx nil
flag 0
)
(if ent
(progn
(setq entl (entget (car ent))
na (strcase (cdr (assoc 0 entl)))
i 0
en (car (reverse (nth 3 ent)))
)
(cond ((or (wcmatch na "TEXT")
(wcmatch na "ATTRIB")
)
(setq txt (cdr (assoc 1 entl)))
)
((wcmatch na "ATTDEF")
(setq txt (cdr (assoc 2 entl)))
)
((wcmatch na "MTEXT")
(setq txt (cdr (assoc 1 entl))
len (strlen txt)
l len
i 1
)
(while (> len 0)
(if (wcmatch (substr txt i 1) ";")
(setq str1 (substr txt 1 i)
str2 (substr txt (+ i 1) (- l i))
len 0
)
)
(setq i (+ i 1)
len (- len 1)
)
)
(if (wcmatch str1 "")
(setq str2 txt)
)
(setq txt str2)
)
)
(if txt
(progn (setq str (wzxgtxt txt)
txt nil
)
(if (= na "MTEXT")
(cond ((wcmatch str "%%130*")
(setq str (strcat "\\U+0082"
(substr str
6
(strlen str)
)
)
)
)
((wcmatch str "%%131*")
(setq str (strcat "\\U+0083"
(substr str
6
(strlen str)
)
)
)
)
((wcmatch str "%%132*")
(setq str (strcat "\\U+0084"
(substr str
6
(strlen str)
)
)
)
)
((wcmatch str "%%133*")
(setq str (strcat "\\U+0085"
(substr str
6
(strlen str)
)
)
)
)
)
)
(setq entl (subst (cons (if (wcmatch na "ATTDEF")
2
1
)
str
)
(assoc (if (wcmatch na "ATTDEF")
2
1
)
entl
)
entl
)
)
(if (= flag 1)
(setq entl (subst (cons 7 "TSSD_REIN")
(assoc 7 entl)
entl
)
)
)
(entmod entl)
(if en
(progn (setq enl (nth 3 ent)
len (length enl)
)
(while (> len 0)
(setq e (nth (- len 1) enl))
(if (or (= "INSERT" (cdr (assoc 0 (entget e))))
(= "DIMENSION" (cdr (assoc 0 (entget e))))
)
(if (= "DIMENSION"
(cdr (assoc 0
(setq el
(entget
(car enl)
)
)
)
)
)
(progn (setq el (subst
(cons 1 str)
(assoc 1 el)
el
)
)
(entmod el)
)
)
)
(entupd e)
(setq len (- len 1))
)
)
(entupd (car ent))
)
)
(princ "\n选取的实体不是文字内容!")
)
)
)
)
(&gscl)
)
[/FONT]

[FONT=courier new] 
(defun c:tybj (/ en ent        entl i l len na        str str1 str2 tx txt wzxgtxt flag e el 
               enl) 
  (defun wzxgtxt (name / a p0 st #doret mdcl str) 
    (defun #doret (/ tf l i ni n1 f) 
      (setq na (get_tile "na")) 
      (if (read na) 
        (progn 
          (if (and (= (get_tile "tg") "1") 
                   (wcmatch na "*[dDfF][1-9]*") 
              ) 
            (progn 
              (setq l         "" 
                    n1         (substr na 1 1) 
                    i         2 
                    flag 1 
              ) 
              (while (
                (setq ni (substr na i 1) 
                      i         (1+ i) 
                ) 
                (cond 
                  ((and        (= n1 "d") 
                        (wcmatch ni "[1-9]") 
                   ) 
                   (setq n1 "%%130") 
                  ) 
                  ((and        (= n1 "D") 
                        (wcmatch ni "[1-9]") 
                   ) 
                   (setq n1 "%%131") 
                  ) 
                  ((and        (= n1 "f") 
                        (wcmatch ni "[1-9]") 
                   ) 
                   (setq n1 "%%132") 
                  ) 
                  ((and        (= n1 "F") 
                        (wcmatch ni "[1-9]") 
                   ) 
                   (setq n1 "%%133") 
                  ) 
                  (t 
                   nil 
                  ) 
                ) 
                (setq l         (strcat l n1) 
                      n1 ni 
                ) 
              ) 
              (setq na (strcat l (substr na (strlen na) 1))) 
            ) 
          ) 
        ) 
        (setq na nil) 
      ) 
      (done_dialog 1) 
    ) 
    (defun mdcl        (/ hi f li na) 
      (if (new_dialog "wzxg" (@dcl "tssdtxt")) 
        (progn (set_tile "na" name) 
               (mode_tile "na" 2) 
               (action_tile 
                 "li" 
                 "(set_tile "na" (nth (atoi $value) li))" 
               ) 
               (action_tile "help" "(help "tssd.hlp" "tybj")") 
               (action_tile "accept" "(#doret)") 
               (start_dialog) 
        ) 
      ) 
      (if na 
        (cons na hi) 
      ) 
    ) 
    (setq st (mdcl)) 
    (&end "文字" t) 
    (&p2l "钢筋") 
    (if        st 
      (setq str (car st)) 
      (setq str name) 
    ) 
    str 
  ) 
  (if (< (&swap) 0) 
    (exit) 
  ) 
  (setq ent 1) 
  (while ent 
    (setq ent  (nentsel "\n选取要修改的文字对象<退出>: ") 
          str1 "" 
          str2 "" 
          tx   nil 
          flag 0 
    ) 
    (if        ent 
      (progn 
        (setq entl (entget (car ent)) 
              na   (strcase (cdr (assoc 0 entl))) 
              i           0 
              en   (car (reverse (nth 3 ent))) 
        ) 
        (cond ((or (wcmatch na "TEXT") 
                   (wcmatch na "ATTRIB") 
               ) 
               (setq txt (cdr (assoc 1 entl))) 
              ) 
              ((wcmatch na "ATTDEF") 
               (setq txt (cdr (assoc 2 entl))) 
              ) 
              ((wcmatch na "MTEXT") 
               (setq txt (cdr (assoc 1 entl)) 
                     len (strlen txt) 
                     l         len 
                     i         1 
               ) 
               (while (> len 0) 
                 (if (wcmatch (substr txt i 1) ";") 
                   (setq str1 (substr txt 1 i) 
                         str2 (substr txt (+ i 1) (- l i)) 
                         len  0 
                   ) 
                 ) 
                 (setq i   (+ i 1) 
                       len (- len 1) 
                 ) 
               ) 
               (if (wcmatch str1 "") 
                 (setq str2 txt) 
               ) 
               (setq txt str2) 
              ) 
        ) 
        (if txt 
          (progn (setq str (wzxgtxt txt) 
                       txt nil 
                 ) 
                 (if (= na "MTEXT") 
                   (cond ((wcmatch str "%%130*") 
                          (setq        str (strcat "\\U+0082" 
                                            (substr str 
                                                    6 
                                                    (strlen str) 
                                            ) 
                                    ) 
                          ) 
                         ) 
                         ((wcmatch str "%%131*") 
                          (setq        str (strcat "\\U+0083" 
                                            (substr str 
                                                    6 
                                                    (strlen str) 
                                            ) 
                                    ) 
                          ) 
                         ) 
                         ((wcmatch str "%%132*") 
                          (setq        str (strcat "\\U+0084" 
                                            (substr str 
                                                    6 
                                                    (strlen str) 
                                            ) 
                                    ) 
                          ) 
                         ) 
                         ((wcmatch str "%%133*") 
                          (setq        str (strcat "\\U+0085" 
                                            (substr str 
                                                    6 
                                                    (strlen str) 
                                            ) 
                                    ) 
                          ) 
                         ) 
                   ) 
                 ) 
                 (setq entl (subst (cons (if (wcmatch na "ATTDEF") 
                                           2 
                                           1 
                                         ) 
                                         str 
                                   ) 
                                   (assoc (if (wcmatch na "ATTDEF") 
                                            2 
                                            1 
                                          ) 
                                          entl 
                                   ) 
                                   entl 
                            ) 
                 ) 
                 (if (= flag 1) 
                   (setq entl (subst (cons 7 "TSSD_REIN") 
                                     (assoc 7 entl) 
                                     entl 
                              ) 
                   ) 
                 ) 
                 (entmod entl) 
                 (if en 
                   (progn (setq        enl (nth 3 ent) 
                                len (length enl) 
                          ) 
                          (while (> len 0) 
                            (setq e (nth (- len 1) enl)) 
                            (if        (or (= "INSERT" (cdr (assoc 0 (entget e)))) 
                                    (= "DIMENSION" (cdr (assoc 0 (entget e)))) 
                                ) 
                              (if (= "DIMENSION" 
                                     (cdr (assoc 0 
                                                 (setq el 
                                                        (entget 
                                                          (car enl) 
                                                        ) 
                                                 ) 
                                          ) 
                                     ) 
                                  ) 
                                (progn (setq el        (subst 
                                                  (cons 1 str) 
                                                  (assoc 1 el) 
                                                  el 
                                                ) 
                                       ) 
                                       (entmod el) 
                                ) 
                              ) 
                            ) 
                            (entupd e) 
                            (setq len (- len 1)) 
                          ) 
                   ) 
                   (entupd (car ent)) 
                 ) 
          ) 
          (princ "\n选取的实体不是文字内容!") 
        ) 
      ) 
    ) 
  ) 
  (&gscl) 
) 
[/FONT]

有破译和再完善的功夫，还不如自己写一个！by xyp1964[/COLOR]

账号		自动登录	找回密码
密码			立即注册

[求助] [求助]：sos!紧急救援！

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

浏览过的版块