明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 23974|回复: 79

[资源] 文字程序(源码)

    [复制链接]
发表于 2011-6-15 18:10:55 | 显示全部楼层 |阅读模式
文字程序
1.te--文字高度匹配
2.za--文字左对齐
3.zs--文字中间对齐
4.zd--文字右对齐
程序来源于 作者:艾瑞可
本人只是稍作修改增加功能而已.
  1. (defun C:te (/ ss  )
  2.   (setvar "cmdecho" 0)
  3.   (prompt "  -->选取文字:")
  4.   (setq ss (ssget '((0 . "TEXT,MTEXT,ATTDEF"))))
  5.   (command "_.scaletext" ss ""  "e" "m")
  6.   (princ)
  7. )
  8. ;*************************************************************************************************
  9. (defun c:ZA (/ b basept)
  10.   (prompt " -->选取文字(左对齐):")
  11.   (setq b(ssget '((0 . "TEXT,MTEXT"))))
  12.   (command "JUSTIFYTEXT" b "" "L" )
  13.   (while (not(setq basept (getpoint"\n 指定对齐点"))))
  14.   (xz:Alignobj (trans basept 1 0) b "Left")
  15.   (prin1)
  16. )
  17. (defun c:ZD (/ b basept)
  18.   (prompt "  -->选取文字(右对齐):")
  19.   (setq b(ssget '((0 . "TEXT,MTEXT"))))
  20.   (command "JUSTIFYTEXT" b "" "R" )
  21.   (while (not(setq basept (getpoint"\n 指定对齐点"))))
  22.   (xz:Alignobj (trans basept 1 0) b "Right")
  23.   (prin1)
  24. )
  25. (defun c:ZS (/ b basept)
  26.   (prompt "  -->选取文字(中间对齐):")
  27.   (setq b(ssget '((0 . "TEXT,MTEXT"))))
  28.   (command "JUSTIFYTEXT" b "" "M" )
  29.   (while (not(setq basept (getpoint"\n 指定对齐点"))))
  30.   (xz:Alignobj (trans basept 1 0) b "Mid_row")
  31.   (prin1)
  32. )
  33. ;*************************************************************************************************
  34. ;以下为子程序.
  35.   ;________
  36. ;获取对象的外边框 参考:object.GetBoundingBox MinPoint, MaxPoint
  37. (defun xz-box (ent / MinPt MaxPt)(vl-load-com)
  38.   (vla-GetBoundingBox (vlax-Ename->vla-Object ent) 'MinPt 'MaxPt)
  39.   (mapcar 'vlax-safearray->list (list MinPt MaxPt))
  40. )
  41. ;;; ******************************************************
  42. ;;; ***;;;
  43. ;;; module: vlex-mid (pts)                              ;;;
  44. ;;; descriptoin:                                  ;;;
  45. ;;; args:                                      ;;;
  46. ;;; example:                                      ;;;
  47. ;;; ******************************************************
  48. ;;; ***;;;
  49. ;;; originally written by michael weaver
  50. ;;; returns the point midway between two others
  51. ;;;
  52. ;;; arguments
  53. ;;; a list of two points
  54. ;;;
  55. ;;; example
  56. ;;; (mid '((1 1 0) (5 5 0)))
  57. ;;; ****************************************************
  58. ;;; ***;;;
  59. (defun vlex-mid (pts / p0 p1)
  60.   (setq p0 (nth 0 pts)
  61.     p1 (nth 1 pts)
  62.   )
  63.   (mapcar '(lambda (ord1 ord2)   (/ (+ ord1 ord2) 2.0) )
  64.     p0
  65.     p1
  66.   )
  67. )

  68. ;获取对象的外边框及中点坐标
  69. ;(xz-box&mid (car (entsel)))
  70. (defun xz-box&mid (ent / pts pt_mid)
  71.   (setq pts (xz-box ent)
  72.   pt_mid (vlex-mid pts)
  73.   )
  74.   (append pts (list pt_mid))
  75. )

  76.   ;________


  77. ;;;Align Objects(2D或3D对齐)---------------------------------------
  78. ;;basept(对齐基点)
  79. ;SS(选择集)
  80. ;POSITION(对齐模式)-"Top Bottom Left Right Mid_row Mid_col"

  81. ;(setq basept (GETPOINT))
  82. ;(SETQ ss (SSGET))
  83. ;(setq POSITION "Top")
  84. ;(xz:Alignobj (GETPOINT)(SSGET) "Mid_col")
  85. (defun xz:Alignobj (basept SS POSITION /  SSM SSN SS1
  86.         MOVE_PLIST  FILTER MOVEPT )

  87. ;(setq basept (getpoint))  

  88.   (setq  SSM (sslength SS)
  89.   SSN 0
  90.   )
  91.   (if (= NIL SS)
  92.     (progn (princ "\n没有选中对象.") (exit))
  93.     (progn
  94.       (cond
  95.   ((= POSITION "Top") (setq FILTER ".Y" MOVEPT 1))
  96.   ((= POSITION "Bottom") (setq FILTER ".Y" MOVEPT 0))
  97.   ((= POSITION "Left")  (setq FILTER ".X"  MOVEPT 0 ))
  98.   ((= POSITION "Right")  (setq FILTER ".X" MOVEPT 1))
  99.   ((= POSITION "Mid_row")  (setq FILTER ".X" MOVEPT 2));中点x方向移动
  100.   ((= POSITION "Mid_col")  (setq FILTER ".Y" MOVEPT 2));中点y方向移动
  101.   (t  (setq FILTER ".X" MOVEPT 0))
  102.   );cond
  103.       (vl-cmdf ".undo" "be")
  104.       (command "_.ucs" "w" )
  105.      (repeat SSM
  106.        (setq SS1        (ssname SS SSN)
  107.        SSN        (1+ SSN)
  108.        MOVE_PLIST (xz-box&mid SS1)
  109.        )
  110.        (vl-cmdf ".MOVE"
  111.           SS1
  112.           ""
  113.           (nth MOVEPT MOVE_PLIST)
  114.           FILTER
  115.           basept
  116.           "@"
  117.        )
  118.      )
  119.       (command "_.ucs" "p" )
  120.      (vl-cmdf ".undo" "end")
  121.      (princ (strcat "\n -->共计移动 " (rtos SSM 2 0) " 个对象.")
  122.      )
  123.     )
  124.   )
  125.   (princ)
  126. )
  127. ;;ALO







评分

参与人数 4明经币 +2 金钱 +30 收起 理由
VBALISPER + 1 我要来支持一下,下载学习\使用.
革天明 + 1
zwqgdhl + 10
raimo + 20 好工具,试用之后发现很好,很实用

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2025-4-20 17:03:02 | 显示全部楼层
感谢 分享        
回复 支持 反对

使用道具 举报

发表于 2019-8-16 10:22:39 | 显示全部楼层

支持支持,谢谢楼主分享
发表于 2025-4-19 13:34:02 | 显示全部楼层

很好的程序支持一下!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2011-6-18 12:54:53 | 显示全部楼层
真奇怪.没支持.
发表于 2011-6-18 13:01:15 | 显示全部楼层
我支持你!大力支持你!
选择用手机上,下不了!
发表于 2011-6-18 13:23:34 | 显示全部楼层
支持支持
发表于 2011-6-18 13:44:24 | 显示全部楼层
新人,初来乍到
支持楼主分享!
发表于 2011-6-18 21:41:40 | 显示全部楼层
支持支持,谢谢楼主分享
发表于 2011-6-18 22:29:07 | 显示全部楼层
学习 并进一步改进
发表于 2011-6-19 01:02:15 | 显示全部楼层
收藏先。。。。。。。。。
发表于 2011-6-19 07:05:40 | 显示全部楼层
本帖最后由 raimo 于 2011-6-19 07:22 编辑

试用之后发现很不错,非常实用的文字对齐工具,比我以前的还好用.
不仅仅是文字位置上的对齐,还能自动修改文字对齐属性,这点我很是赞同

就是还少了一个,现在都是文字垂直对齐的,如果能补上一个水平对齐就更加完美了..
 楼主| 发表于 2011-6-19 10:54:08 | 显示全部楼层
里面的子程序能够轻松实现 楼上 的功能.
自己加吧.懒得弄.
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2025-5-1 01:18 , Processed in 0.185777 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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