[编程申请]：求块文字编辑的LISP（附部分源代码）

gzlish · 发表于 2006-4-28 22:12:07

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

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

×

如题，求能够不炸开块就能编辑块里面的文字的LISP，如探素者（TSSD）中的“通用编辑”。
附部分源代码，希望哪位高手把它完成。
(setfunhelp"c:Tybj""tssd.hlp""tybj")
(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]*"))
   (setq na(&rtxt na))))(setq na nil))(done_dialog 1)
   )
(defun mdcl(/ hi f li na st)(setq st(findfile"ck.exe"))
   (if(new_dialog"wzxg"(@dcl"Wztool"))
      (progn(set_tile"na"name)
      (mode_tile"na"2)
      (if st(action_tile"ck""(startapp st)"))
      (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))
(&glay"当前文字"t)
(&tsty"标号文字")
(if st(setq str(car st))(setq str name))
str
)
(if(<(&beg)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))))
               )
               ((wcmatch str"%%146*")
                 (setq str(strcat"\\U+0092"(substr str 6(strlen str))))
               )
               ((wcmatch str"%%147*")
                 (setq str(strcat"\\U+0093"(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选取的实体不是文字内容!")
)
)
)
)
(&end)
)

还有DCL资源：

//所有文字工具的对话框

wzxg : dialog {
  label = "文字输入" ;
  : row {
   : toggle {
      key = "tg" ;
      value = "1" ;
      label = "d/D/f/F 转换为钢筋直径" ;
   }
   : button {
      label = "词库>";
      key = "ck";
      fixed_width = true;
   }
}
  : edit_box {
key = "na" ;
label = "内容：" ;
  }
  ok_cancel_help_errtile ;
}

bobby_yang · 发表于 2006-5-31 10:35:09

不知道这个行不行？

fjs0515 · 发表于 2006-12-7 11:50:57

你的东西我下不下来

jx2008 · 发表于 2007-1-18 22:53:42

非常好的程序，但是应该改成中文阿，是用汉语怎么还整英文呢？

wujimmy · 发表于 2007-9-27 07:16:33

这个代码很好啊.

fengsea · 发表于 2007-11-20 00:23:40

二楼的lisp还不够完善，楼主可能需要的是支持：单行、多行、标注、尺寸、组、块中的文字都能修改文字内容且不修改其它属性！

fengsea · 发表于 2007-11-20 00:29:31

二楼的lisp还不够完善，楼主可能需要的是支持：单行、多行、标注、尺寸、组、块中的文字都能修改文字内容且不修改其它属性！

176489156 · 发表于 2007-12-14 15:30:42

出现点的现象
不太好用

ding9736 · 发表于 2008-4-6 12:25:21

块里的文字用属性标签写不就好了吗

god1478 · 发表于 2008-5-20 18:47:43

就是要快捷的liso 呵呵谢谢楼主

aibia · 发表于 2008-8-7 16:34:30

你的东西我下不下来

zzlphp · 发表于 2008-10-17 19:29:51

谁能帮改一下呀，我们在等待。谢谢了。

jx2008 · 发表于 2008-11-5 10:39:38

对于锁定冻结的块可能不能编辑

eric.kang · 发表于 2008-11-21 14:19:58

看起來蠻深奧的,貼下來試看看.

albbzdc156 · 发表于 2008-12-13 19:36:01

谢谢了 2楼的附件能下载

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

[编程申请]：求块文字编辑的LISP（附部分源代码）

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

相关帖子