设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 文字对齐
返回列表 发新帖
查看: 8200|回复: 9

文字对齐

[复制链接]
自贡黄明儒
发表于 2012-2-25 14:16:48 | 显示全部楼层 |阅读模式
本帖最后由 自贡黄明儒 于 2013-3-23 12:08 编辑

;;;关于对齐，明经中有不少的好程序了，但多半操作复杂。用得最多的恐怕是文字对齐。我原来用Align的程序，
;;;是编译过的.但这个程序什么对象都用来对齐，不能满足我的需要。于是.....

  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;自贡黄明儒
  2. (defun C:ao (/ CMDECHO1 KEY SSET SSETCIRCLE SSETELSE SSETINSERT SSETMTEXT SSETTEXT SSETATTDEF)
  3.   ;;1  选择集相减
  4.   (defun SS_SSsub (ss1 ss2 / ss)
  5.     (command "._Select" ss1 "_Remove" ss2 "")
  6.     (if (equal (sslength ss1) (sslength ss2))
  7.       nil
  8.       (setq ss (ssget "_P"))
  9.     )
  10.   )
  11.   ;;2  获取对象的外边框
  12.   (defun HH:MinMaxPt (ent / MinPt MaxPt)
  13.     ;;(vl-load-com)
  14.     (vla-GetBoundingBox (vlax-Ename->vla-Object ent) 'MinPt 'MaxPt)
  15.     (mapcar 'vlax-safearray->list (list MinPt MaxPt))
  16.   )
  17.   ;;3.1  text选择集在x方向距离<文字宽度,认为在同一列
  18.   ;;   左中 中中对齐方式有效
  19.   (defun HH:TextInSameColu (ss / E1 E2 LIS1 LIS2 N P1 P2 SS1 WID1 WID2)
  20.     (setq e1 (ssname ss 0))
  21.     (setq SS1 (ssadd e1 (ssadd)))
  22.     (setq lis1 (HH:MinMaxPt e1))
  23.     (setq wid1 (- (car (cadr lis1)) (car (car lis1))))
  24.     (setq p1 (cdr (assoc 11 (entget e1))))
  25.     (setq n 0)
  26.     (repeat (1- (sslength ss))
  27.       (setq e2 (ssname ss (setq n (1+ n))))
  28.       (setq lis2 (HH:MinMaxPt e2))
  29.       (setq wid2 (- (car (cadr lis2)) (car (car lis2))))
  30.       (setq p2 (cdr (assoc 11 (entget e2))))
  31.       (if (< (abs (- (car p1) (car p2))) (max wid1 wid2))
  32.         (progn (setq SS1 (ssadd e2 ss1)) (vl-cmdf "_.MOVE" e2 "" p2 ".X" p1 "@"))
  33.       )
  34.     )
  35.     ss1
  36.   )
  37.   ;;3.2  Mtext选择集在x方向距离<文字宽度,认为在同一列
  38.   ;;   左中 中中对齐方式有效
  39.   (defun HH:MTextInSameColu (ss / E1 E2 LIS1 LIS2 N P1 P2 SS1 WID1 WID2)
  40.     (setq e1 (ssname ss 0))
  41.     (setq SS1 (ssadd e1 (ssadd)))
  42.     (setq lis1 (HH:MinMaxPt e1))
  43.     (setq wid1 (- (car (cadr lis1)) (car (car lis1))))
  44.     (setq p1 (cdr (assoc 10 (entget e1))))
  45.     (setq n 0)
  46.     (repeat (1- (sslength ss))
  47.       (setq e2 (ssname ss (setq n (1+ n))))
  48.       (setq lis2 (HH:MinMaxPt e2))
  49.       (setq wid2 (- (car (cadr lis2)) (car (car lis2))))
  50.       (setq p2 (cdr (assoc 10 (entget e2))))
  51.       (if (< (abs (- (car p1) (car p2))) (max wid1 wid2))
  52.         (progn (setq SS1 (ssadd e2 ss1)) (vl-cmdf "_.MOVE" e2 "" p2 ".X" p1 "@"))
  53.       )
  54.     )
  55.     ss1
  56.   )
  57.   ;;4.1 text在Y方向距离,圆整成字高2倍
  58.   ;;   左中 中中对齐方式有效
  59.   (defun HH:TextInSameRow (ss / E1 E2 H HIG1 LIS1 N P1 P2 P2T)
  60.     (setq e1 (ssname ss 0))
  61.     (setq lis1 (HH:MinMaxPt e1))
  62.     (setq hig1 (* 2.0 (- (cadr (cadr lis1)) (cadr (car lis1)))))
  63.     (setq p1 (cdr (assoc 11 (entget e1))))
  64.     (setq n 0)
  65.     (repeat (1- (sslength ss))
  66.       (setq e2 (ssname ss (setq n (1+ n))))
  67.       (setq p2 (cdr (assoc 11 (entget e2))))
  68.       (setq H (- (cadr p2) (cadr p1)))
  69.       (if (> H 0)
  70.         (setq H (fix (+ (/ H hig1) 0.5)))
  71.         (setq H (fix (- (/ H hig1) 0.5)))
  72.       )
  73.       (setq p2t (list (car p1) (+ (* H hig1) (cadr p1)) 0.0))
  74.       (vl-cmdf "_.MOVE" e2 "" p2 ".Y" p2t "@")
  75.     )
  76.   )
  77.   ;;4.2 Mtext在Y方向距离,圆整成字高2倍
  78.   ;;   左中 中中对齐方式有效
  79.   (defun HH:MTextInSameRow (ss / E1 E2 H HIG1 LIS1 N P1 P2 P2T)
  80.     (setq e1 (ssname ss 0))
  81.     (setq lis1 (HH:MinMaxPt e1))
  82.     (setq hig1 (* 2.0 (- (cadr (cadr lis1)) (cadr (car lis1)))))
  83.     (setq p1 (cdr (assoc 10 (entget e1))))
  84.     (setq n 0)
  85.     (repeat (1- (sslength ss))
  86.       (setq e2 (ssname ss (setq n (1+ n))))
  87.       (setq p2 (cdr (assoc 10 (entget e2))))
  88.       (setq H (* (- (cadr p2) (cadr p1)) 2.0))
  89.       (if (> H 0)
  90.         (setq H (fix (+ (/ H hig1) 0.5)))
  91.         (setq H (fix (- (/ H hig1) 0.5)))
  92.       )
  93.       (setq p2t (list (car p1) (+ (* H hig1) (cadr p1)) 0.0))
  94.       (vl-cmdf "_.MOVE" e2 "" p2 ".Y" p2t "@")
  95.     )
  96.   )
  97.   ;;5.1  Text选择集中找出相同列,返回其余
  98.   (defun Textsamecolum (sSet / SS SS1)
  99.     (setq ss1 (HH:TextInSameColu sSet))
  100.     (if (setq ss (SS_SSsub sSet ss1))
  101.       (Textsamecolum ss)
  102.     )
  103.   )
  104.   ;;5.2  MText选择集中找出相同列,返回其余
  105.   (defun MTextsamecolum (sSet / SS SS1)
  106.     (setq ss1 (HH:MTextInSameColu sSet))
  107.     (if (setq ss (SS_SSsub sSet ss1))
  108.       (MTextsamecolum ss)
  109.     )
  110.   )
  111.   ;;6  主程序
  112.   (if (cadr (ssgetfirst))
  113.     (setq sSet (ssget "_P" '((0 . "*TEXT"))))
  114.   )
  115.   (if sSet
  116.     nil
  117.     (setq sSet (ssget))
  118.   )
  119.   (vl-load-com)
  120.   (command "undo" "be")
  121.   (setq cmdecho1 (getvar "cmdecho"))
  122.   (setvar "cmdecho" 0)
  123.   (command "._Select" sSet "")
  124.   (setq sSetText (ssget "_p" '((0 . "TEXT"))))
  125.   (command "._Select" sSet "")
  126.   (setq sSetMText (ssget "_p" '((0 . "MTEXT"))))
  127.   (command "._Select" sSet "")
  128.   (setq sSetATTDEF (ssget "_p" '((0 . "ATTDEF"))))
  129.   (command "._Select" sSet "")
  130.   (setq sSetCIRCLE (ssget "_p" '((0 . "CIRCLE,ARC,ELLIPSE"))))
  131.   (command "._Select" sSet "")
  132.   (setq sSetINSERT (ssget "_p" '((0 . "INSERT"))))  
  133.   (cond (sSetText
  134.          (initget "mC mL");区分大小写
  135.          (setq key (getkword "\n文本对齐于 [正中(C)/左中(L)]:<C>"))
  136.          (if (not key)
  137.            (setq key "MC")
  138.          )
  139.          (setq key (strcase key))
  140.          (command "_.JUSTIFYTEXT" sSetText "" key)
  141.          (HH:TextInSameRow sSetText)
  142.          (Textsamecolum sSetText)
  143.         )
  144.         (sSetMText
  145.          (initget "mC mL")
  146.          (setq key (getkword "\n文本对齐于 [正中(C)/左中(L)]:<C>"))
  147.          (if (not key)
  148.            (setq key "MC")
  149.          )
  150.          (setq key (strcase key))
  151.          (command "_.JUSTIFYTEXT" sSetMText "" key)
  152.          (HH:MTextInSameRow sSetMText)
  153.          (MTextsamecolum sSetMText)
  154.         )
  155.         (sSetATTDEF
  156.          (initget "mC mL")
  157.          (setq key (getkword "\n文本对齐于 [正中(C)/左中(L)]:<C>"))
  158.          (if (not key)
  159.            (setq key "MC")
  160.          )
  161.          (setq key (strcase key))
  162.          (command "_.JUSTIFYTEXT" sSetATTDEF "" key)
  163.          (HH:TextInSameRow sSetATTDEF)
  164.          (Textsamecolum sSetATTDEF)
  165.         )
  166.         (sSetCIRCLE (HH:MTextInSameRow sSetCIRCLE) (MTextsamecolum sSetCIRCLE))
  167.         (sSetINSERT (HH:MTextInSameRow sSetINSERT) (MTextsamecolum sSetINSERT))
  168.         (T (princ "\n 只能处理文字、圆(椭圆)、块"))
  169.   )
  170.   (setvar "cmdecho" cmdecho1)
  171.   (command "undo" "END")
  172.   (princ)
  173. )
  174. (princ "\n  命令:AO")
  175. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


程序

本帖子中包含更多资源

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

x

点评

puzb2001
很好的程序。学习了。  发表于 2012-3-13 14:18

评分

参与人数 1明经币 +1 收起 理由
vlisp2012 + 1 很给力!

查看全部评分

"觉得好，就打赏"
打赏
还没有人打赏，支持一下

本帖被以下淘专辑推荐:

相关帖子
回复

使用道具 举报

自贡黄明儒
 楼主| 发表于 2012-2-25 14:20:16 | 显示全部楼层
默认行间距为：第一个对象高度的2倍
回复 支持 反对

使用道具 举报

puzb2001
发表于 2012-2-25 14:33:27 | 显示全部楼层
大师作品，纯顶！

点评

自贡黄明儒
千万别叫“大师",我也只是将各位高手的程序结合了一下而已。说实在的，我也是懂点皮毛。  发表于 2012-2-25 14:39
回复 支持 反对

使用道具 举报

vlisp2012
发表于 2012-2-25 16:01:55 | 显示全部楼层
很好的程序。学习了。
回复 支持 反对

使用道具 举报

自贡黄明儒
 楼主| 发表于 2012-3-13 11:34:00 | 显示全部楼层
原来的不能文字避让，自己希望改后的更好
回复 支持 反对

使用道具 举报

wjl1014
发表于 2013-3-23 11:30:25 | 显示全部楼层
程序不错，就是要收费。
回复 支持 反对

使用道具 举报

42112522
发表于 2013-6-23 19:37:15 | 显示全部楼层

默认行间距为：第一个对象高度的2倍
回复 支持 反对

使用道具 举报

非你可1
发表于 2014-3-3 19:38:58 | 显示全部楼层
非常哇塞啊
回复 支持 反对

使用道具 举报

上善如水
发表于 2014-4-16 20:28:00 | 显示全部楼层
如果能加个排序就更好了
回复 支持 反对

使用道具 举报

消失的天空
发表于 2019-5-2 10:52:08 | 显示全部楼层
先收藏了。不知道效果怎么样，我一直在找表格内文字对齐，能横竖同时运行的。
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2025-5-18 20:07 , Processed in 0.189342 second(s), 32 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表