（完成）[编程申请]：竖排汉字。

XDSoft · 发表于 2002-8-4 22:38:19

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

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

×

程序写好了，可以竖（斜）排，请试用。

登录/注册后可看大图

[FONT=courier new]
;|
命令：txt_sp
功能：文字竖（斜）排
说明：1、可以多选文字
2、可以输入Y、X向间距，也可以通过鼠标拾取点定间距，还可以用默认的字高的五分之一作Y间距。
3、Y向只能输入正值，X向偏移可以正负。
程序配合XDRX_API build 20630＋版本使用，朋友们可以把这个LISP拷贝到“晓东工具箱”的安装的
LISP目录，自己加入到菜单里面就可以非常方便的使用了。
关于程序的建议请到“晓东CAD空间-编程申请”论坛
[url]http://www.xdcad.net/forum留言[/url]
|;
(defun c:txt_sp (/ ss tf e basept txt txt1 thigh dist dist1 box oldorth t_matrix
i j
)
(prompt "\n请选取要竖排的文字<退出>:")
(if (setq ss (ssget '((0 . "text"))))
(progn
(xdrx_begin)
(xdrx_ucson)
(xdrx_setsstodb ss 0)
(setq tf t)
(while (setq e (xdrx_getentdata 0))
(setq basept (xdrx_getentdxf 10)
box (xdrx_entity_box e)
basept (car box)
thigh (xdrx_getentdxf 40)
txt (xdrx_getentdxf 1)
txt (xdrx_string_trimLeft (xdrx_string_trimRight txt))
)
(if tf
(progn
(setq oldorth (getvar "orthomode"))
(setvar "orthomode" 1)
(initget 6)
(setq dist (getdist basept
"\n请输入竖向Y文字间距<字高五分之一>:"
)
)
(if (not (setq dist1 (getdist basept "\n请输入横向X偏移距离<0>:")))
(setq dist1 0.0)
)
(setvar "orthomode" oldorth)
(if (null dist)
(setq dist (* 6 (/ thigh 5.0)))
(setq dist (+ dist thigh))
)
(setq t_matrix (xdrx_matrix_identity 3)
t_matrix (xdrx_matrix_SetTranslation t_matrix
(list dist1
(- dist) 0.0
)
)
tf nil
)
)
)
(setq i 1
j 0
)
(while (/= "" (setq txt1 (substr txt i 1)))
(if (> (ascii txt1) 159)
(progn
(setq txt1 (substr txt i 2)
i (1+ i)
)
)
)
(setq i (1+ i))
(if (= j 0)
(progn
(xdrx_modent 1 txt1 10 basept)
(setq j 1)
)
(progn
(xdrx_entity_TransformedCopy e t_matrix)
(xdrx_entity_SetPropertiesFrom (entlast) e)
(setq e (entlast))
(xdrx_setenttodb e)
(xdrx_modent 1 txt1)
)
)
)
)
)
)
(princ)
)
[/FONT]

[FONT=courier new] 
 
;| 
   命令：txt_sp 
    
   功能：文字竖（斜）排 
    
   说明：1、可以多选文字 
        2、可以输入Y、X向间距，也可以通过鼠标拾取点定间距，还可以用默认的字高的五分之一作Y间距。 
        3、Y向只能输入正值，X向偏移可以正负。 
 
        程序配合XDRX_API build 20630＋版本使用，朋友们可以把这个LISP拷贝到“晓东工具箱”的安装的 
        LISP目录，自己加入到菜单里面就可以非常方便的使用了。 
        关于程序的建议请到“晓东CAD空间-编程申请”论坛 
        [url]http://www.xdcad.net/forum留言[/url]          
         
|; 
(defun c:txt_sp (/ ss tf e basept txt txt1 thigh dist dist1 box oldorth t_matrix 
                   i j 
                ) 
  (prompt "\n请选取要竖排的文字<退出>:") 
  (if (setq ss (ssget '((0 . "text")))) 
    (progn 
      (xdrx_begin) 
      (xdrx_ucson) 
      (xdrx_setsstodb ss 0) 
      (setq tf t) 
      (while (setq e (xdrx_getentdata 0)) 
        (setq basept (xdrx_getentdxf 10) 
              box (xdrx_entity_box e) 
              basept (car box) 
              thigh (xdrx_getentdxf 40) 
              txt (xdrx_getentdxf 1) 
              txt (xdrx_string_trimLeft (xdrx_string_trimRight txt)) 
        ) 
        (if tf 
          (progn 
            (setq oldorth (getvar "orthomode")) 
            (setvar "orthomode" 1) 
            (initget 6) 
            (setq dist (getdist basept 
                                "\n请输入竖向Y文字间距<字高五分之一>:" 
                       ) 
            ) 
            (if (not (setq dist1 (getdist basept "\n请输入横向X偏移距离<0>:"))) 
              (setq dist1 0.0) 
            ) 
            (setvar "orthomode" oldorth) 
            (if (null dist) 
              (setq dist (* 6 (/ thigh 5.0))) 
              (setq dist (+ dist thigh)) 
            ) 
            (setq t_matrix (xdrx_matrix_identity 3) 
                  t_matrix (xdrx_matrix_SetTranslation t_matrix 
                                                       (list dist1 
                                                             (- dist) 0.0 
                                                       ) 
                           ) 
                  tf nil 
            ) 
          ) 
        ) 
        (setq i 1 
              j 0 
        ) 
        (while (/= "" (setq txt1 (substr txt i 1))) 
          (if (> (ascii txt1) 159) 
            (progn 
              (setq txt1 (substr txt i 2) 
                    i (1+ i) 
              ) 
            ) 
          ) 
          (setq i (1+ i)) 
          (if (= j 0) 
            (progn 
              (xdrx_modent 1 txt1 10 basept) 
              (setq j 1) 
            ) 
            (progn 
              (xdrx_entity_TransformedCopy e t_matrix) 
              (xdrx_entity_SetPropertiesFrom (entlast) e) 
              (setq e (entlast)) 
              (xdrx_setenttodb e) 
              (xdrx_modent 1 txt1) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
) 
[/FONT]

CCarch · 发表于 2002-8-5 00:16:11

这个功能相信在规划中最好用！

XDSoft · 发表于 2002-8-7 00:51:45

又增加了个工具，“竖排恢复”，请大家下载附件的LISP，包括了上面的“竖斜排”程序。

[FONT=courier new]
;|
命令：txt_ressp
功能：将竖排后的文字恢复成单行文字。
说明：1、文字样式、属性、位置按照最上排的文字。
程序配合XDRX_API build 20630＋版本使用，朋友们可以把这个LISP拷贝到“晓东工具箱”的安装的
LISP目录，自己加入到菜单里面就可以非常方便的使用了。
关于程序的建议请到“晓东CAD空间-编程申请”论坛
[url]http://www.xdcad.net/forum留言[/url]
|;
(defun c:txt_ressp (/ ss box basept dis ptl tf txt e n)
(prompt "\n请选取要恢复到横排的文字<退出>:")
(if (setq ss (ssget '((0 . "text"))))
(progn
(xdrx_begin)
(xdrx_setsstodb ss 0)
(setq box (xdrx_entity_box ss))
(while (setq e (xdrx_getentdata 0))
(setq basept (xdrx_getentdxf 10)
dis (xdrx_p2ldist basept (nth 3 box) (nth 2 box))
ptl (cons (list dis e) ptl)
)
)
(setq ptl (apply
'xdrx_rlistsort2
ptl
)
)
(setq tf t
txt ""
)
(foreach n ptl
(xdrx_setenttodb (cadr n))
(setq txt (strcat txt (xdrx_getentdxf 1)))
(if tf
(progn
(setq e (cadr n)
tf nil
)
)
(entdel (cadr n))
)
)
(xdrx_setenttodb e)
(xdrx_modent 1 txt)
(xdrx_end)
)
)
(princ)
)
[/FONT]

[FONT=courier new] 
;| 
   命令：txt_ressp 
    
   功能：将竖排后的文字恢复成单行文字。 
    
   说明：1、文字样式、属性、位置按照最上排的文字。 
 
        程序配合XDRX_API build 20630＋版本使用，朋友们可以把这个LISP拷贝到“晓东工具箱”的安装的 
        LISP目录，自己加入到菜单里面就可以非常方便的使用了。 
        关于程序的建议请到“晓东CAD空间-编程申请”论坛 
        [url]http://www.xdcad.net/forum留言[/url]          
 
|; 
(defun c:txt_ressp (/ ss box basept dis ptl tf txt e n) 
  (prompt "\n请选取要恢复到横排的文字<退出>:") 
  (if (setq ss (ssget '((0 . "text")))) 
    (progn 
      (xdrx_begin) 
      (xdrx_setsstodb ss 0) 
      (setq box (xdrx_entity_box ss)) 
      (while (setq e (xdrx_getentdata 0)) 
        (setq basept (xdrx_getentdxf 10) 
              dis (xdrx_p2ldist basept (nth 3 box) (nth 2 box)) 
              ptl (cons (list dis e) ptl) 
        ) 
      ) 
      (setq ptl (apply 
                  'xdrx_rlistsort2 
                  ptl 
                ) 
      ) 
      (setq tf t 
            txt "" 
      ) 
      (foreach n ptl 
        (xdrx_setenttodb (cadr n)) 
        (setq txt (strcat txt (xdrx_getentdxf 1))) 
        (if tf 
          (progn 
            (setq e (cadr n) 
                  tf nil 
            ) 
          ) 
          (entdel (cadr n)) 
        ) 
      ) 
      (xdrx_setenttodb e) 
      (xdrx_modent 1 txt) 
      (xdrx_end) 
    ) 
  ) 
  (princ) 
) 
[/FONT]

eachy · 发表于 2002-8-7 01:44:26

哈哈，可以不用前面的文字连接了。

XDSoft · 发表于 2002-8-7 01:47:43

最初由 eachy 发布
[B]哈哈，可以不用前面的文字连接了。 [/B]

这个工具仅仅考虑了“Y”方向的排序，没有考虑“X”向（同行中的几个文字实体的情况）。所以仅仅叫做“竖排恢复”：）

以后提供完美的排版工具。

xzg_hello · 发表于 2002-8-7 19:38:33

呵呵，字处理的小工具浓缩整理一下都可以出专集了

梦断江南 · 发表于 2002-8-7 20:02:57

等等我，我也要凑凑热闹

cad517 · 发表于 2002-8-8 17:42:04

我觉得e2002的几个字符串工具也很好啊

XDSoft · 发表于 2002-8-8 17:51:29

最初由 cad517 发布
[B]我觉得e2002的几个字符串工具也很好啊 [/B]

现在正在给大家写“文字处理”的程序，您有什么新的想法，请发到论坛，出出注意，谢谢！

xzg_hello · 发表于 2002-8-9 16:24:16

最初由 XDSoft 发布
[B]

现在正在给大家写“文字处理”的程序，您有什么新的想法，请发到论坛，出出注意，谢谢！ [/B]

:4

这确实是个好消息
我希望这个程序主界面类似于ACAD的Mtext，但功能更强大，更贴近用户使用意愿，例如，当用户框选了一批文字时，右键菜单中出现字处理的各种选项，诸如合并并编辑、统一字形、竖（斜）排文字等等，当选择合并并编辑时，出现主编辑界面，该界面中有各种编辑工具和类似软键盘的功能，另外，如果将表格的制作与排版融入进来那就更棒了，毕竟在所有字处理中，表格中的文字是最难处理的

caibaobao · 发表于 2002-8-14 18:41:16

赞同，但是不要像MTEXT那样，一镜像后会移动到后面：（

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

（完成）[编程申请]：竖排汉字。

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

相关帖子