[LISP程序]：CAD文字排版小程序

B!ueice · 发表于 2005-6-25 18:31:02

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

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

×

先传个小东东给大家试试：CAD文字排版小程序

hytech888 · 发表于 2005-6-30 19:43:59

介绍一下可以吗

qmx · 发表于 2005-7-1 13:03:56

给个说明嘛

jinsong-liao · 发表于 2005-7-4 11:51:12

程序说明

此软件能解决CAD文字编辑、排版的不足，能轻易实现统一CAD文字字高、用水平方式和垂直方式对CAD文字进行排版处理。

使用方法

软件加载：打开菜单：工具----加载应用程序，即成功加载程序了。程序加载后，会暗示命令帮助提示

*********************************************************
               文字排版命令程序命令表
         QA........以垂直方式对齐排列各文字行
         QW........以水平方式对齐排列各文字行
         QS........统一字高
************************************************
         欢迎使用“文字排版软件” Ver 2.00
      作者：叶永湛          广东吉业集团有限公司
      Ver: 2.0             泡泡：yongzhan829
*********************************************************

xyp1964 · 发表于 2005-7-16 10:19:09

while的方法不好：

[FONT=courier new]
(DEFUN C:QA ()
(WHILE
(PRINC
"\n***** 选择作为向左以垂直方式对齐排列标准的文字行(只能单选) *****"
)
(SETQ ss (SSGET '((0 . "TEXT"))))
(SETQ s1 (SSNAME ss 0))
(SETQ s-en (ENTGET s1))
(SETQ pt10 (ASSOC '10 s-en)
s-mode (ASSOC '0 s-en)
s-la (ASSOC '8 s-en)
)
(SETQ pt-y (CADR pt10))
(PRINC
"***** 选择要向左以垂直方式对齐排列的文字行(可单选可多选) *****"
)
(SETQ ss1 (SSGET (LIST s-mode s-la)))
(SETQ i 0)
(SETQ s-n (SSLENGTH ss1))
(WHILE (< i s-n)
(SETQ s-1 (SSNAME ss1 i))
(SETQ i (+ i 1))
(SETQ e-s-1 (ENTGET s-1))
(SETQ pt10-s-1 (ASSOC '10 e-s-1))
(SETQ ssJ (CADR pt10-s-1))
(SETQ s1J
(SUBST pt-y
ssJ
pt10-s-1
)
)
(SETQ s-enJ
(SUBST s1J
pt10-s-1
e-s-1
)
)
(ENTMOD s-enJ)
)
(PRINC "*******【操作结果】共有")
(PRINC s-n)
(PRINC "行文字向左以垂直方式对齐排列 *******\n")
(PRINC)
)
)
(DEFUN C:QW ()
(WHILE
(PRINC
"\n***** 选择作为以水平方式对齐排列标准的文字行(只能单选) *****"
)
(SETQ ss (SSGET '((0 . "TEXT"))))
(SETQ s1 (SSNAME ss 0))
(SETQ s-en (ENTGET s1))
(SETQ pt10 (ASSOC '10 s-en)
s-mode (ASSOC '0 s-en)
s-la (ASSOC '8 s-en)
)
(SETQ pt-y (CADDR pt10))
(PRINC
"***** 选择要以水平方式对齐排列的文字行(可单选可多选) *****"
)
(SETQ ss1
(SSGET (LIST s-mode s-la))
)
(SETQ i 0)
(SETQ s-n (SSLENGTH ss1))
(WHILE (< i s-n)
(SETQ s-1 (SSNAME ss1 i))
(SETQ i (+ i 1))
(SETQ e-s-1 (ENTGET s-1))
(SETQ pt10-s-1 (ASSOC '10 e-s-1))
(SETQ ssJ (CADDR pt10-s-1))
(SETQ s1J
(SUBST pt-y
ssJ
pt10-s-1
)
)
(SETQ s-enJ
(SUBST s1J
pt10-s-1
e-s-1
)
)
(ENTMOD s-enJ)
)
(PRINC "*********【操作结果】共有")
(PRINC s-n)
(PRINC "行文字以水平方式对齐排列 *********\n")
(PRINC)
)
)
(DEFUN C:QS ()
(WHILE (PRINC "\n**** 请选择要改变字高的字符串 ****")
(SETQ ss1 (SSGET '((0 . "TEXT"))))
(SETQ i 0)
(SETQ s-n (SSLENGTH ss1))
(SETQ pt10J (GETREAL "\n** 请输入文字高度<500>:"))
(IF (= pt10J NIL)
(SETQ pt10J 500)
)
(WHILE (< i s-n)
(SETQ s-1 (SSNAME ss1 i))
(SETQ i (+ i 1))
(SETQ e-s-1 (ENTGET s-1))
(SETQ pt10-s-1 (ASSOC '40 e-s-1))
(SETQ ssJ (CDR pt10-s-1))
(SETQ s1J (CONS 40 pt10J))
(SETQ s-enJ
(SUBST s1J
pt10-s-1
e-s-1
)
)
(ENTMOD s-enJ)
)
(PRINC "**** 改变字高的字符串的数量是: ")
(PRINC s-n)
(PRINC " ****")
)
(PRINC)
)
;4
;(PRINC "\n\n***** 文字排版命令程序已经加载 *****\n")
;(PRINC "\n*********************************************************")
;(PRINC "\n 文字排版命令程序命令表")
(PRINC
"\n
QA........以垂直方式对齐排列各文字行\n
QW........以水平方式对齐排列各文字行\n
QS........统一字高\n"
)
;(PRINC " ************************************************\n")
;(PRINC " 欢迎使用“文字排版软件” Ver 2.00\n")
;(PRINC " 作者：叶永湛广东吉业集团有限公司\nVer: 2.0 泡泡：yongzhan829")
;(PRINC "\n********************************************************")[/FONT]

[FONT=courier new] 
(DEFUN C:QA () 
  (WHILE 
    (PRINC 
      "\n***** 选择作为向左以垂直方式对齐排列标准的文字行(只能单选) *****" 
    ) 
     (SETQ ss (SSGET '((0 . "TEXT")))) 
     (SETQ s1 (SSNAME ss 0)) 
     (SETQ s-en (ENTGET s1)) 
     (SETQ pt10          (ASSOC '10 s-en) 
           s-mode (ASSOC '0 s-en) 
           s-la          (ASSOC '8 s-en) 
     ) 
     (SETQ pt-y (CADR pt10)) 
     (PRINC 
       "***** 选择要向左以垂直方式对齐排列的文字行(可单选可多选) *****" 
     ) 
     (SETQ ss1 (SSGET (LIST s-mode s-la))) 
     (SETQ i 0) 
     (SETQ s-n (SSLENGTH ss1)) 
     (WHILE (
       (SETQ s-1 (SSNAME ss1 i)) 
       (SETQ i (+ i 1)) 
       (SETQ e-s-1 (ENTGET s-1)) 
       (SETQ pt10-s-1 (ASSOC '10 e-s-1)) 
       (SETQ ssJ (CADR pt10-s-1)) 
       (SETQ s1J 
              (SUBST pt-y 
                     ssJ 
                     pt10-s-1 
              ) 
       ) 
       (SETQ s-enJ 
              (SUBST s1J 
                     pt10-s-1 
                     e-s-1 
              ) 
       ) 
       (ENTMOD s-enJ) 
     ) 
     (PRINC "*******【操作结果】共有") 
     (PRINC s-n) 
     (PRINC "行文字向左以垂直方式对齐排列 *******\n") 
     (PRINC) 
  ) 
) 
 
(DEFUN C:QW () 
  (WHILE 
    (PRINC 
      "\n***** 选择作为以水平方式对齐排列标准的文字行(只能单选) *****" 
    ) 
     (SETQ ss (SSGET '((0 . "TEXT")))) 
     (SETQ s1 (SSNAME ss 0)) 
     (SETQ s-en (ENTGET s1)) 
     (SETQ pt10          (ASSOC '10 s-en) 
           s-mode (ASSOC '0 s-en) 
           s-la          (ASSOC '8 s-en) 
     ) 
     (SETQ pt-y (CADDR pt10)) 
     (PRINC 
       "***** 选择要以水平方式对齐排列的文字行(可单选可多选) *****" 
     ) 
     (SETQ ss1 
            (SSGET (LIST s-mode s-la)) 
     ) 
     (SETQ i 0) 
     (SETQ s-n (SSLENGTH ss1)) 
     (WHILE (
       (SETQ s-1 (SSNAME ss1 i)) 
       (SETQ i (+ i 1)) 
       (SETQ e-s-1 (ENTGET s-1)) 
       (SETQ pt10-s-1 (ASSOC '10 e-s-1)) 
       (SETQ ssJ (CADDR pt10-s-1)) 
       (SETQ s1J 
              (SUBST pt-y 
                     ssJ 
                     pt10-s-1 
              ) 
       ) 
       (SETQ s-enJ 
              (SUBST s1J 
                     pt10-s-1 
                     e-s-1 
              ) 
       ) 
       (ENTMOD s-enJ) 
     ) 
     (PRINC "*********【操作结果】共有") 
     (PRINC s-n) 
     (PRINC "行文字以水平方式对齐排列 *********\n") 
     (PRINC) 
  ) 
) 
 
(DEFUN C:QS () 
  (WHILE (PRINC "\n**** 请选择要改变字高的字符串 ****") 
    (SETQ ss1 (SSGET '((0 . "TEXT")))) 
    (SETQ i 0) 
    (SETQ s-n (SSLENGTH ss1)) 
    (SETQ pt10J (GETREAL "\n** 请输入文字高度<500>:")) 
    (IF        (= pt10J NIL) 
      (SETQ pt10J 500) 
    ) 
    (WHILE (
      (SETQ s-1 (SSNAME ss1 i)) 
      (SETQ i (+ i 1)) 
      (SETQ e-s-1 (ENTGET s-1)) 
      (SETQ pt10-s-1 (ASSOC '40 e-s-1)) 
      (SETQ ssJ (CDR pt10-s-1)) 
      (SETQ s1J (CONS 40 pt10J)) 
      (SETQ s-enJ 
             (SUBST s1J 
                    pt10-s-1 
                    e-s-1 
             ) 
      ) 
      (ENTMOD s-enJ) 
    ) 
    (PRINC "**** 改变字高的字符串的数量是: ") 
    (PRINC s-n) 
    (PRINC " ****") 
  ) 
  (PRINC) 
) 
 
                                        ;4 
                                        ;(PRINC "\n\n***** 文字排版命令程序已经加载 *****\n") 
                                        ;(PRINC  "\n*********************************************************") 
                                        ;(PRINC "\n                  文字排版命令程序命令表") 
(PRINC 
  "\n 
            QA........以垂直方式对齐排列各文字行\n 
            QW........以水平方式对齐排列各文字行\n 
            QS........统一字高\n" 
) 
                                        ;(PRINC  "    ************************************************\n") 
                                        ;(PRINC "             欢迎使用“文字排版软件” Ver 2.00\n") 
                                        ;(PRINC  "        作者：叶永湛  广东吉业集团有限公司\nVer: 2.0  泡泡：yongzhan829") 
                                        ;(PRINC  "\n********************************************************")[/FONT]

eachy · 发表于 2005-7-16 10:44:33

垂直对齐最简单的就是用特性管理器修改 Y 值

B!ueice · 发表于 2005-9-22 14:06:59

大家的意见都很好啊！！
我到九寨沟去出差才回来，几个月没上网了，没能给大家回话表示深深的歉意！
我是搞公路设计的，大家有什么经验一起交流哈！！
我建了个群，欢迎大家加入：12867492。
希望大家在这个群里多多交流经验！！！*-*9

sonny99 · 发表于 2005-9-22 15:47:58

支持发帖子...呵呵。...

AQJ · 发表于 2005-9-23 15:42:47

很好呵呵，我正找这个呢！谢谢拉！

shiuanwen · 发表于 2005-9-24 00:19:28

是不是要用autolisp寫程式 autocad才會好用呢

狂刀 · 发表于 2005-9-24 09:12:39

不是这么说的吧，呵呵。
好不好用跟用什么做没有什么关系，跟怎么做有关系

huimin23 · 发表于 2005-9-24 15:15:57

好谢谢你的宝贵资料

B!ueice · 发表于 2005-9-26 13:29:52

只要对大家的工作有帮助就是我最大的快乐！
我以后会陆续上传有用的工具的！！

我建了个群，欢迎大家加入：12867492。
希望大家在这个群里多多交流经验！！！

桃花岛主 · 发表于 2005-9-28 12:57:35

好东西

B!ueice · 发表于 2005-10-1 02:37:32

等几天我忙完了就慢慢的把纬地5.6的PJ给大家传上来哈!
希望大家到我的群里交流经验!!!

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

[LISP程序]：CAD文字排版小程序

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

相关帖子

浏览过的版块