找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 5335|回复: 20

[研讨] [功能]文字对齐

[复制链接]

已领礼包: 604个

财富等级: 财运亨通

发表于 2014-12-11 16:35:52 | 显示全部楼层 |阅读模式

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

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

×
本帖最后由 /db_自贡黄明儒_ 于 2014-12-11 16:43 编辑

[功能]文字对齐
前言:
我原来认为,CAD以图形表达为主,根本不用关心文字排列的问题,更不用编程来处理。但后来发现,这个观点是错误的,文字传递的信息也很重要。元老LL_J编的那个程序经过试用,是我见过最好的,唯一的缺点是速度慢(可能是当时的电脑不行)和用户的选项太多,当时也没有读懂(也许今天能读懂了,嘿嘿)
后来自己写了一个,今天整理了一下。这一整理,用了些自己的公用函数。感觉速度还可以。

  1. ;;HH:ssPts:Sort http://bbs.xdcad.net/thread-670556-1-1.html
  2. ;;SS_SSsub http://bbs.xdcad.net/thread-678101-1-1.html
  3. ;;optimizeCode http://bbs.xdcad.net/thread-678104-1-1.html
  4. ;;Entity:Box By ST http://bbs.xdcad.net/thread-677384-1-1.html
  5. ;;HH::EntSSHighLight  http://bbs.mjtd.com/thread-111599-1-1.html
  6. ;;HH:Ent4pt http://bbs.mjtd.com/thread-107647-1-1.html
  7. ;;HH::List-p  http://bbs.mjtd.com/thread-111576-1-1.html
  8. ;;ayEntSSHighLight  http://bbs.mjtd.com/thread-109203-1-1.html
  9. ;;HH:ayEntSSHighLight  http://bbs.mjtd.com/thread-109203-1-1.html
  10. ;;-----------------分类对象对齐命令 AO
  11. (defun C:AO (/ CODE FILTERLST FLAG H H1 KEY LST P0 SS SSET SSETATTDEF SSETCIRCLE SSETINSERT SSETMTEXT SSETTEXT VALIST0 VARLIST VARTXTLST W0)
  12.   (defun *error* (msg)
  13.     (vl-bt)
  14.     (cond (*DOC* (_EndUndo *DOC*)))
  15.     (while (not (equal (getvar "cmdnames") "")) (command nil))
  16.     (HH:Once=>Init VARLIST valist0)
  17.     (princ "\n 出错啦!")
  18.     (princ)
  19.   )
  20.   
  21.   ;;第一个图元及其列的图元,返回剩余表
  22.   ;;取表中第一个图元,后面X误差较小认为在同一列
  23.   (defun w2 (lst Flag code p0 h1 w0 / L P)   
  24.     (while
  25.       (and
  26.         (setq p (car lst))
  27.         (setq p (cdr (assoc code (entget p))))
  28.         (cond ((equal (car p) (car p0) w0)
  29.                (setq l (cons (car lst) l))
  30.                (setq lst (cdr lst))
  31.               )
  32.         )
  33.       )
  34.     )
  35.     (HH:SameCol (REVERSE l) code p0 h1)                            ;*同列
  36.     lst
  37.   )
  38.   ;;----例表图元最大宽度
  39.   (defun HH:MaxWidth (lst / W W0)
  40.     (setq w0 0)
  41.     (foreach x lst
  42.       (setq w (abs (car (apply 'mapcar (cons '- (Entity:Box x))))))
  43.       (cond ((> w w0) (setq w0 w)))
  44.     )
  45.     w0
  46.   )
  47.   ;;----例表图元最大宽度

  48.   ;;AO子函数****同列处理
  49.   ;;以p0为基点,X方向对齐
  50.   ;;Flag T时是文字 h1行间距
  51.   (defun HH:SameCol (l code p0 h1 / EN I P)
  52.     (setq i -1)
  53.     (foreach x l
  54.       (setq en (entget x))      
  55.       (setq p (mapcar '+ (list 0 (* (setq i (1+ i))  h1)) p0))
  56.       (entmod (subst (cons code p) (assoc code en) en))
  57.     )
  58.   )
  59.   ;;AO子函数****同列处理
  60.   ;;7  本程序主程序
  61.   (cond        ((cadr (ssgetfirst))
  62.          (setq sSet (ssget "_P" '((0 . "*TEXT,ATTDEF,CIRCLE,ARC,ELLIPSE,INSERT"))))
  63.         )
  64.   )
  65.   (princ "\n 单行文字、多行文字、块、圆依次择其一类对齐")
  66.   (cond        ((not sSet)
  67.          (setq sSet (ssget '((0 . "*TEXT,ATTDEF,CIRCLE,ARC,ELLIPSE,INSERT"))))
  68.         )
  69.   )
  70.   (cond
  71.     (sSet
  72.      (vl-load-com)
  73.      (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))
  74.      (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))
  75.      (_StartUndo *DOC*)
  76.      (setq VARLIST (list "cmdecho" "osmode" "shortcutmenu"))
  77.      (setq valist0 (HH:Once=>get VARLIST))
  78.      (HH:Once=>Init VARLIST (list 0 0 11))
  79.      (setq vartxtlst (list "sSetText" "sSetMText" "sSetATTDEF" "sSetCIRCLE" "sSetINSERT"))
  80.      (setq filterlst (list "TEXT" "MTEXT" "ATTDEF" "CIRCLE,ARC,ELLIPSE" "INSERT"))
  81.      (optimizeCode sSet vartxtlst filterlst)
  82.      ;;对文字预处理
  83.      (cond ((or sSetText sSetMText sSetATTDEF)
  84.             (initget "mC mL")                                    ;区分大小写
  85.             (setq key (getkword "\n文本对齐于 [正中(C)/左中(L)]:<C>"))
  86.             (cond ((not key) (setq key "MC")))
  87.             (command "_.JUSTIFYTEXT" sSetText "" (strcase key))
  88.            )
  89.      )
  90.      ;;只取其中一类
  91.      (setq ss (cond (sSetText)
  92.                     (sSetMText)
  93.                     (sSetATTDEF)
  94.                     (sSetINSERT)
  95.                     (sSetCIRCLE)
  96.               )
  97.      )
  98.      (setq Flag (or sSetText sSetMText sSetATTDEF))            ;T表示文字
  99.      (setq h (apply 'mapcar (cons '- (Entity:Box (ssname ss 0)))))
  100.      (setq h (* (abs (cadr h)) 2));默认间距
  101.      (initget 46)
  102.      (setq h1 (getreal (strcat "\n >>输入行间距<" (VL-PRINC-TO-STRING h) ">:")))
  103.      (cond ((not h1) (setq h1 h)))
  104.      (cond ((or sSetText sSetATTDEF) (setq code 11))
  105.            (T (setq code 10))
  106.      )
  107.      (setq lst (HH:ssPts:Sort ss "xy" (* h 0.75 0.5)))                    ;下到上,左到右 (HH:SortEndByPt
  108.      (setq p0 (cdr (assoc code (entget (car lst)))))            ;左下
  109.      (setq w0 (HH:MaxWidth lst))                            ;最大宽度
  110.      (while (car lst)
  111.        (cond ((setq lst (w2 lst Flag code p0 h1 w0));处理同列图元
  112.               (setq p0 (list (cadr (assoc code (entget (car lst)))) (cadr p0)))
  113.              )
  114.        )
  115.      )
  116.      (HH:Once=>Init VARLIST valist0)
  117.      (_EndUndo *DOC*)
  118.      (command "_.select" ss "")                                    ;因为ss内对象有些已经删除
  119.      (HH::EntSSHighLight (ssget "_p"))
  120.     )
  121.   )                                                            ;原ayEntSSHighLight
  122.   (princ "\n 分类对象对齐命令 AO")
  123.   (princ)
  124. )
  125. (princ "\n 黄明儒温馨提示:分类对象对齐命令 AO")
  126. ;;-----------------分类对象对齐命令 AO
1.gif
2.gif

评分

参与人数 2D豆 +15 收起 理由
lucas3 + 5 很给力!经验;技术要点;资料分享奖!
XDSoft + 10 很给力!经验;技术要点;资料分享奖!

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 5601个

财富等级: 富甲天下

发表于 2014-12-11 17:40:55 | 显示全部楼层
谢谢黄大侠的好程序!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 3199个

财富等级: 富可敌国

发表于 2014-12-11 18:55:40 | 显示全部楼层
支持长老,为什么要用到HH:ONCE=>INIT 这个函数?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 3199个

财富等级: 富可敌国

发表于 2014-12-11 20:02:49 | 显示全部楼层
长老能提供HH:ONCE=>INIT  与HH:ONCE=>GET 这几个函数吗? 搜索论坛没有找到,谢谢!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

 楼主| 发表于 2014-12-11 20:05:50 来自手机 | 显示全部楼层
处理变量而已,你可以去除

点评

注释掉了,但还是出错了 命令: ao 单行文字、多行文字、块、圆依次择其一类对齐 选择对象: 指定对角点: 找到 4 个 选择对象: _.select 选择对象: 找到 4 个 选择对象: 命令: _.select 选择对象: 找  详情 回复 发表于 2014-12-11 20:20
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 3199个

财富等级: 富可敌国

发表于 2014-12-11 20:20:24 | 显示全部楼层
/db_自贡黄明儒_ 发表于 2014-12-11 20:05
处理变量而已,你可以去除

注释掉了,但还是出错了

命令: ao
单行文字、多行文字、块、圆依次择其一类对齐
选择对象: 指定对角点: 找到 4 个
选择对象:  _.select
选择对象:   找到 4 个
选择对象:
命令: _.select
选择对象:   找到 4 个
选择对象:
命令: _.select
选择对象:   找到 4 个
选择对象:
命令: _.select
选择对象:   找到 4 个
选择对象:
命令: _.select
选择对象:   找到 4 个
选择对象:
命令:
文本对齐于 [正中(C)/左中(L)]:<C>C
_.JUSTIFYTEXT
选择对象:   找到 4 个
选择对象:
输入对正选项
[左(L)/对齐(A)/调整(F)/中心(C)/中间(M)/右(R)/左上(TL)/中上(TC)/右上(TR)/左中(ML)/正中(MC)/右中(MR)/左下(
BL)/中下(BC)/右下(BR)] <左中>: MC
命令:
反向跟踪:
[0.52] (VL-BT)
[1.48] (*ERROR* "参数类型错误: consp <图元名: 7efa8e40>")
[2.43] (_call-err-hook #<SUBR @104b8528 *ERROR*> "参数类型错误: consp <图元名:
7efa8e40>")
[3.37] (sys-error "参数类型错误: consp <图元名: 7efa8e40>")
:ERROR-BREAK.32 nil
[4.29] (CAR <图元名: 7efa8e40>)
[5.24] (ENTITY:BOX <图元名: 7efa8e40>)
[6.19] (C:AO)
[7.15] (#<SUBR @104b8604 -rts_top->)
[8.12] (#<SUBR @0f092334 veval-str-body> "(C:AO)" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)
:ARQ-SUBR-CALLBACK.3 (nil 0)
出错啦!

点评

1 看版规 2 从信息看,使用ENTITY:BOX时要转成vla3 告诉你一个绝技,你不要告诉他人。即使你认为这个程序不错,应该加一豆  详情 回复 发表于 2014-12-12 08:31
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

 楼主| 发表于 2014-12-12 08:31:33 | 显示全部楼层
lucas3 发表于 2014-12-11 20:20
注释掉了,但还是出错了

命令: ao

1 看版规
2 从信息看,使用ENTITY:BOX时要转成vla3 告诉你一个绝技,你不要告诉他人。即使你认为这个程序不错,应该加一豆{:soso_e120:}

点评

没违法版规吧 发源码的都是好同志,程序好别说加一豆,加100豆都不是问题,但问题是现在还没有运行成功过  详情 回复 发表于 2014-12-12 08:40
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 3199个

财富等级: 富可敌国

发表于 2014-12-12 08:40:00 | 显示全部楼层
/db_自贡黄明儒_ 发表于 2014-12-12 08:31
1 看版规
2 从信息看,使用ENTITY:BOX时要转成vla3 告诉你一个绝技,你不要告诉他人。即使你认为这个程 ...

没违法版规吧
发源码的都是好同志,程序好别说加一豆,加100豆都不是问题,但问题是现在还没有运行成功过{:soso_e127:}
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1268个

财富等级: 财源广进

发表于 2014-12-12 09:03:35 来自手机 | 显示全部楼层
lucas3 发表于 2014-12-12 08:40
没违法版规吧
发源码的都是好同志,程序好别说加一豆,加100豆都不是问题,但问题是现在还没有运行成功 ...

黄老把用到的函数链接在顶部都给出了

点评

应改是Entify:BOX函数的问题, ;;Entity:Box By ST http://bbs.xdcad.net/thread-677384-1-1.html 在上面链接中未找到完整的Entity:Box函数 找到一个API版本的,试了下可行, (defun Entity:Box (ss / an box fr  详情 回复 发表于 2014-12-12 09:31
是的,我也添加进去了,可还是出错,出错信息上面贴出来了  详情 回复 发表于 2014-12-12 09:09
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 3199个

财富等级: 富可敌国

发表于 2014-12-12 09:09:27 | 显示全部楼层
st788796 发表于 2014-12-12 09:03
黄老把用到的函数链接在顶部都给出了

是的,我也添加进去了,可还是出错,出错信息上面贴出来了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 3199个

财富等级: 富可敌国

发表于 2014-12-12 09:31:56 | 显示全部楼层
st788796 发表于 2014-12-12 09:03
黄老把用到的函数链接在顶部都给出了

应改是Entify:BOX函数的问题,
;;Entity:Box By ST http://bbs.xdcad.net/thread-677384-1-1.html
在上面链接中未找到完整的Entity:Box函数
找到一个API版本的,试了下可行,
(defun Entity:Box (ss / an box from mat mat0 pj r to)
  (xdrx_document_ucsoff)
  (setq box (xdrx_entity_box ss))
  (if (not (xdrx_document_iswcs))
    (progn
      (setq an (XD::UCS:Angle)
            pj (car box)
            mat0 (xdrx_matrix_identity 3)
            from (list pj (getvar "ucsxdir") (getvar "ucsydir") (XD::UCS:ZDir))
            to (list pj '(1 0 0) '(0 1 0) '(0 0 1))
            mat (xdrx_matrix_AlignCoordSystem from to)
      )
      (xdrx_entity_transform ss Mat)
      (setq box (xdrx_entity_box ss))
      (xdrx_entity_transform ss (setq r (xdrx_matrix_inverse Mat)))
      (setq box (XD::Pnts:WCS2UCS (XD::Pnts:Transform box r)))
    )
  )
  box
)

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 2个

财富等级: 恭喜发财

发表于 2014-12-12 21:18:31 | 显示全部楼层
本帖最后由 adc 于 2014-12-12 22:03 编辑

谢谢提醒,加上这两个了(defun _StartUndo ( doc ) (vla-StartUndoMark doc))
  (defun _EndUndo   ( doc ) (if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-EndUndomark doc)))

点评

这个提示信息已经很明确了哟  详情 回复 发表于 2014-12-12 21:33
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 3199个

财富等级: 富可敌国

发表于 2014-12-12 21:33:33 | 显示全部楼层
adc 发表于 2014-12-12 21:18
为什么提示这个
反向跟踪:
[0.51] (VL-BT)

这个提示信息已经很明确了哟

点评

adc
你提供的Entity:Box函数里有很更多未知的函数,请问能不能给个完整的的,多谢了  详情 回复 发表于 2014-12-12 21:41
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 2个

财富等级: 恭喜发财

发表于 2014-12-12 21:41:38 | 显示全部楼层
lucas3 发表于 2014-12-12 21:33
这个提示信息已经很明确了哟

你提供的Entity:Box函数里有很更多未知的函数,请问能不能给个完整的的,多谢了

点评

晕啊,你都签到70多天了,应该看到过XD API这几个字母吧,哈哈 http://bbs.xdcad.org/thread-668896-1-1.html  详情 回复 发表于 2014-12-12 21:58
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 3199个

财富等级: 富可敌国

发表于 2014-12-12 21:58:25 | 显示全部楼层
adc 发表于 2014-12-12 21:41
你提供的Entity:Box函数里有很更多未知的函数,请问能不能给个完整的的,多谢了

晕啊,你都签到70多天了,应该看到过XD API这几个字母吧,哈哈
http://bbs.xdcad.org/thread-668896-1-1.html
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-15 04:23 , Processed in 0.193193 second(s), 59 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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