明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 13403|回复: 52

对象对齐---天公劝我重抖擞,字不对齐誓不休

    [复制链接]
发表于 2012-3-14 09:19:04 | 显示全部楼层 |阅读模式
本帖最后由 自贡黄明儒 于 2012-8-23 10:21 编辑

我见95%以上的AutoCAD绘图人员(哎,见识太少),字体总是对不齐(嘿嘿,我也是其中之一,说来惭愧!),这要怪Autocad,谁让它不提供对象对齐工具呢(借口还可以吧)?
热心网友提供的文字对齐工具,有些是操作复杂,有些运行慢......总之不符合我的要求。原来写了一个,不能进行文字避让,今有所改善,希望能完美。
运行结果证明,还是有瑕疵,伸出你高贵的手,为了我们共同的目标,完善它,推广它。在此我给菩萨心肠的你鞠躬了。一鞠躬,二鞠躬,三鞠躬......

  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. (defun C:ao (/  CMDECHO1   E1       HIG1  HIG2     KEY        LIS1
  4.       SS  SSET    SSETATTDEF SSETCIRCLE SSETINSERT SSETMTEXT  SSETTEXT
  5.      )
  6.   ;;2  点表排序
  7.   (defun Sort_X_pList (PLIST / p1 p2)
  8.     (setq plist (vl-sort plist
  9.     '(lambda (p1 p2)
  10.        (cond ((< (car p1) (car p2)) T)
  11.       (T nil)
  12.        )
  13.      )
  14.   )
  15.     )
  16.   )
  17.   ;;3  选择集相减
  18.   (defun SS_SSsub (ss1 ss2 / ss)
  19.     (command "._Select" ss1 "_Remove" ss2 "")
  20.     (if (equal (sslength ss1) (sslength ss2))
  21.       nil
  22.       (setq ss (ssget "_P"))
  23.     )
  24.   )
  25.   ;;4  获取对象的外边框
  26.   (defun HH:MinMaxPt (ent / MinPt MaxPt)
  27.     (vla-GetBoundingBox
  28.       (vlax-Ename->vla-Object ent)
  29.       'MinPt
  30.       'MaxPt
  31.     )
  32.     (mapcar 'vlax-safearray->list (list MinPt MaxPt))
  33.   )
  34.   ;;5  处理列******************************************************
  35.   ;;   左中 中中对齐方式有效
  36.   ;;  Mtext code=10,其余code=11
  37.   (defun TextInSameCol (ss     code   hig1   /     E1    E2   H  I LIS1
  38.    LIS2   LISTMINUS     LISTPLUS    N   P1  P2 elist
  39.    SS1    WID    WID1   WID2   Y
  40.          )
  41.     (setq e1 (ssname ss 0))
  42.     (setq SS1 (ssadd e1 (ssadd)))
  43.     (setq lis1 (HH:MinMaxPt e1))
  44.     (setq wid1 (- (car (cadr lis1)) (car (car lis1))))
  45.     (setq p1 (cdr (assoc code (entget e1))))
  46.     (setq n 0)
  47.     (repeat (1- (sslength ss))
  48.       (setq e2 (ssname ss (setq n (1+ n))))
  49.       (setq lis2 (HH:MinMaxPt e2))
  50.       (setq wid2 (- (car (cadr lis2)) (car (car lis2))))
  51.       (setq p2 (cdr (assoc code (entget e2))))
  52.       (setq H (- (cadr p2) (cadr p1)))
  53.       (setq wid (< (abs (- (car p1) (car p2))) (/ (+ wid1 wid2) 2.0)))
  54.       (if wid
  55. (progn
  56.    (setq SS1 (ssadd e2 ss1))
  57.    (if (> H 0)
  58.      (setq ListPlus (cons (list H e2) ListPlus))
  59.      (setq ListMinus (cons (list H e2) ListMinus))
  60.    )
  61. )
  62.       )
  63.     )
  64.     (setq ListPlus (Sort_X_pList ListPlus))
  65.     (setq ListMinus (reverse (Sort_X_pList ListMinus)))
  66.     (setq i 0)
  67.     (setq n (length ListPlus))
  68.     (if ListPlus
  69.       (repeat n
  70. (setq i (1+ i))
  71. (setq e2 (cadr (car ListPlus)))
  72. (setq ListPlus (cdr ListPlus))
  73. (setq p2 (cdr (assoc code (entget e2))))
  74. (setq y (- (cadr p2) (cadr p1)))
  75. (if (> (setq y (fix (+ (/ y hig1) 0.5))) i)
  76.    (setq i y)
  77. )
  78. (setq elist (entget e2))
  79. (setq p2 (list (car p1) (+ (cadr p1) (* i hig1)) 0.0))
  80. (entmod (subst (cons code p2) (assoc code elist) elist))
  81.       )
  82.     )
  83.     (setq i 0)
  84.     (setq n (length ListMinus))
  85.     (if ListMinus
  86.       (repeat n
  87. (setq i (1+ i))
  88. (setq e2 (cadr (car ListMinus)))
  89. (setq ListMinus (cdr ListMinus))
  90. (setq p2 (cdr (assoc code (entget e2))))
  91. (setq y (- (cadr p1) (cadr p2)))
  92. (if (> (setq y (fix (+ (/ y hig1) 0.5))) i)
  93.    (setq i y)
  94. )
  95. (setq elist (entget e2))
  96. (setq p2 (list (car p1) (- (cadr p1) (* i hig1)) 0.0))
  97. (entmod (subst (cons code p2) (assoc code elist) elist))
  98.       )
  99.     )
  100.     (setq ss (SS_SSsub ss ss1))
  101.     (if ss
  102.       (TextInSameCol ss code hig1)
  103.     )
  104.   )
  105.   ;;6  Y间距<行间距hig1,认为在同一行,则使其在x向对齐**********************
  106.   ;;   左中 中中对齐方式有效
  107.   ;;  Mtext code=10,其余code=11
  108.   ;;(setq ss (ssget) code 11 hig1 7)
  109.   (defun TextInSameRow (ss code hig1 / E1 E2 H N P1 P2 SS1 elist)
  110.     (setq e1 (ssname ss 0))
  111.     (setq SS1 (ssadd e1 (ssadd)))
  112.     (setq p1 (cdr (assoc code (entget e1))))
  113.     (setq n 0)
  114.     (repeat (1- (sslength ss))
  115.       (setq e2 (ssname ss (setq n (1+ n))))
  116.       (setq p2 (cdr (assoc code (entget e2))))
  117.       (setq H (abs (- (cadr p1) (cadr p2))))
  118.       (if (< (abs H) hig1)
  119. (progn (setq SS1 (ssadd e2 ss1))
  120.    (setq elist (entget e2))
  121.    (setq p2 (list (car p2) (cadr p1) 0.0))
  122.    (entmod (subst (cons code p2) (assoc code elist) elist))    ;在Y向移动
  123. )
  124.       )
  125.     )
  126.     (setq ss (SS_SSsub ss ss1))
  127.     (if ss
  128.       (TextInSameRow ss code hig1)
  129.     )
  130.   )

  131.   ;;7  主程序
  132.   (if (cadr (ssgetfirst))
  133.     (setq
  134.       sSet (ssget "_P"
  135.     '((0 . "*TEXT,ATTDEF,CIRCLE,ARC,ELLIPSE,INSERT"))
  136.     )
  137.     )
  138.   )
  139.   (princ "\n 单行文字、多行文字、块、圆依次择其一类对齐")
  140.   (if sSet
  141.     nil
  142.     (setq
  143.       sSet (ssget '((0 . "*TEXT,ATTDEF,CIRCLE,ARC,ELLIPSE,INSERT")))
  144.     )
  145.   )
  146.   (vl-load-com)
  147.   (command "undo" "be")
  148.   (setq cmdecho1 (getvar "cmdecho"))
  149.   (setvar "cmdecho" 0)
  150.   (command "._Select" sSet "")
  151.   (setq sSetText (ssget "_p" '((0 . "TEXT"))))
  152.   (command "._Select" sSet "")
  153.   (setq sSetMText (ssget "_p" '((0 . "MTEXT"))))
  154.   (command "._Select" sSet "")
  155.   (setq sSetATTDEF (ssget "_p" '((0 . "ATTDEF"))))
  156.   (command "._Select" sSet "")
  157.   (setq sSetCIRCLE (ssget "_p" '((0 . "CIRCLE,ARC,ELLIPSE"))))
  158.   (command "._Select" sSet "")
  159.   (setq sSetINSERT (ssget "_p" '((0 . "INSERT"))))
  160.   (if (or sSetText sSetMText sSetATTDEF)
  161.     (progn (initget "mC mL")       ;区分大小写
  162.     (setq key (getkword "\n文本对齐于 [正中(C)/左中(L)]:<C>"))
  163.     (if (not key)
  164.       (setq key "MC")
  165.     )
  166.     (setq key (strcase key))
  167.     (command "_.JUSTIFYTEXT" sSetText "" key)
  168.     )
  169.   )
  170.   (cond (sSetText (setq ss sSetText))
  171. (sSetMText (setq ss sSetMText))
  172. (sSetATTDEF (setq ss sSetATTDEF))
  173. (sSetINSERT (setq ss sSetINSERT))
  174. (sSetCIRCLE (setq ss sSetCIRCLE))
  175.   )
  176.   (setq e1 (ssname ss 0))
  177.   (setq lis1 (HH:MinMaxPt e1))
  178.   (initget 46)
  179.   (setq hig2 (* 2.0 (- (cadr (cadr lis1)) (cadr (car lis1)))))
  180.   (setq
  181.     hig1 (getreal (strcat "\n >>输入行间距<" (rtos hig2 2 3) ">:"))
  182.   )
  183.   (if hig1
  184.     nil
  185.     (setq hig1 hig2)
  186.   )
  187.   (cond (sSetText
  188.   (TextInSameRow sSetText 11 hig1)
  189.   (TextInSameCol sSetText 11 hig1)  
  190. )
  191. (sSetMText
  192.   (TextInSameRow sSetMText 10 hig1)
  193.   (TextInSameCol sSetMText 10 hig1)  
  194. )
  195. (sSetATTDEF
  196.   (TextInSameRow sSetATTDEF 11 hig1)
  197.   (TextInSameCol sSetATTDEF 11 hig1)  
  198. )
  199. (sSetINSERT
  200.   (TextInSameRow sSetINSERT 10 hig1)
  201.   (TextInSameCol sSetINSERT 10 hig1)  
  202. )
  203. (sSetCIRCLE
  204.   (TextInSameRow sSetCIRCLE 10 hig1)
  205.   (TextInSameCol sSetCIRCLE 10 hig1)  
  206. )
  207.   )
  208.   (setvar "cmdecho" cmdecho1)
  209.   (command "undo" "END")
  210.   (princ)
  211. )
  212. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

mccad给予好评了,怎么也得将代码优化一下,见压缩文件
优化方法http://bbs.mjtd.com/thread-93264-1-1.html


本帖子中包含更多资源

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

x

点评

一鞠躬,二鞠躬,三鞠躬......哪位翘翘了?  发表于 2012-8-8 18:05
根本就没有我想像中那么美  发表于 2012-6-15 12:11
谢谢分享  发表于 2012-3-14 14:40

评分

参与人数 3明经币 +3 收起 理由
flytoday + 1 很给力!
669423907 + 1 精神可嘉!
mccad + 1 赞一个!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2020-11-1 18:58:28 | 显示全部楼层
自贡黄明儒   你好  我想问一下  附件的大小是0byte  下载下来是不能用的  损坏的文件
发表于 2019-6-19 10:45:41 | 显示全部楼层
很不错的工具,不过还可以再改进一下,谢谢分享
发表于 2020-3-19 23:00:05 | 显示全部楼层
这个功能真的好强大!
发表于 2012-3-14 11:14:04 | 显示全部楼层
赞一个,附件跟贴出来的程序是不是一个东西?
 楼主| 发表于 2012-3-14 11:26:20 | 显示全部楼层
本帖最后由 自贡黄明儒 于 2012-3-14 11:29 编辑
xiaxiang 发表于 2012-3-14 11:14
赞一个,附件跟贴出来的程序是不是一个东西?


是一个东西,只差一个函数Sort_X_pList。其实没有这个函数,你也可以猜出来
发表于 2012-3-14 11:44:03 | 显示全部楼层
原来是少一个点表排序函数!程序功能不错,感谢分享!
发表于 2012-3-14 11:56:47 | 显示全部楼层
谢谢楼主分享
发表于 2012-3-14 12:00:03 | 显示全部楼层
谢谢楼主分享,楼主精神可嘉!
发表于 2012-3-14 14:40:42 | 显示全部楼层
谢谢楼主分享
发表于 2012-3-14 15:01:14 | 显示全部楼层
xx ,如果再配上个动画,此帖必更火

点评

动画不会弄,我看就这样吧,货识有缘人!  发表于 2012-3-17 09:20
发表于 2012-3-14 18:13:46 | 显示全部楼层
不错支持一下下
发表于 2012-3-14 21:21:19 | 显示全部楼层
多谢楼主分享,学习了
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-11-6 07:35 , Processed in 0.182397 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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