文字程序(源码)
文字程序1.te--文字高度匹配
2.za--文字左对齐
3.zs--文字中间对齐
4.zd--文字右对齐
程序来源于 作者:艾瑞可
本人只是稍作修改增加功能而已.
(defun C:te (/ ss)
(setvar "cmdecho" 0)
(prompt "-->选取文字:")
(setq ss (ssget '((0 . "TEXT,MTEXT,ATTDEF"))))
(command "_.scaletext" ss """e" "m")
(princ)
)
;*************************************************************************************************
(defun c:ZA (/ b basept)
(prompt " -->选取文字(左对齐):")
(setq b(ssget '((0 . "TEXT,MTEXT"))))
(command "JUSTIFYTEXT" b "" "L" )
(while (not(setq basept (getpoint"\n 指定对齐点"))))
(xz:Alignobj (trans basept 1 0) b "Left")
(prin1)
)
(defun c:ZD (/ b basept)
(prompt "-->选取文字(右对齐):")
(setq b(ssget '((0 . "TEXT,MTEXT"))))
(command "JUSTIFYTEXT" b "" "R" )
(while (not(setq basept (getpoint"\n 指定对齐点"))))
(xz:Alignobj (trans basept 1 0) b "Right")
(prin1)
)
(defun c:ZS (/ b basept)
(prompt "-->选取文字(中间对齐):")
(setq b(ssget '((0 . "TEXT,MTEXT"))))
(command "JUSTIFYTEXT" b "" "M" )
(while (not(setq basept (getpoint"\n 指定对齐点"))))
(xz:Alignobj (trans basept 1 0) b "Mid_row")
(prin1)
)
;*************************************************************************************************
;以下为子程序.
;________
;获取对象的外边框 参考:object.GetBoundingBox MinPoint, MaxPoint
(defun xz-box (ent / MinPt MaxPt)(vl-load-com)
(vla-GetBoundingBox (vlax-Ename->vla-Object ent) 'MinPt 'MaxPt)
(mapcar 'vlax-safearray->list (list MinPt MaxPt))
)
;;; ******************************************************
;;; ***;;;
;;; module: vlex-mid (pts) ;;;
;;; descriptoin: ;;;
;;; args: ;;;
;;; example: ;;;
;;; ******************************************************
;;; ***;;;
;;; originally written by michael weaver
;;; returns the point midway between two others
;;;
;;; arguments
;;; a list of two points
;;;
;;; example
;;; (mid '((1 1 0) (5 5 0)))
;;; ****************************************************
;;; ***;;;
(defun vlex-mid (pts / p0 p1)
(setq p0 (nth 0 pts)
p1 (nth 1 pts)
)
(mapcar '(lambda (ord1 ord2) (/ (+ ord1 ord2) 2.0) )
p0
p1
)
)
;获取对象的外边框及中点坐标
;(xz-box&mid (car (entsel)))
(defun xz-box&mid (ent / pts pt_mid)
(setq pts (xz-box ent)
pt_mid (vlex-mid pts)
)
(append pts (list pt_mid))
)
;________
;;;Align Objects(2D或3D对齐)---------------------------------------
;;basept(对齐基点)
;SS(选择集)
;POSITION(对齐模式)-"Top Bottom Left Right Mid_row Mid_col"
;(setq basept (GETPOINT))
;(SETQ ss (SSGET))
;(setq POSITION "Top")
;(xz:Alignobj (GETPOINT)(SSGET) "Mid_col")
(defun xz:Alignobj (basept SS POSITION /SSM SSN SS1
MOVE_PLISTFILTER MOVEPT )
;(setq basept (getpoint))
(setqSSM (sslength SS)
SSN 0
)
(if (= NIL SS)
(progn (princ "\n没有选中对象.") (exit))
(progn
(cond
((= POSITION "Top") (setq FILTER ".Y" MOVEPT 1))
((= POSITION "Bottom") (setq FILTER ".Y" MOVEPT 0))
((= POSITION "Left")(setq FILTER ".X"MOVEPT 0 ))
((= POSITION "Right")(setq FILTER ".X" MOVEPT 1))
((= POSITION "Mid_row")(setq FILTER ".X" MOVEPT 2));中点x方向移动
((= POSITION "Mid_col")(setq FILTER ".Y" MOVEPT 2));中点y方向移动
(t(setq FILTER ".X" MOVEPT 0))
);cond
(vl-cmdf ".undo" "be")
(command "_.ucs" "w" )
(repeat SSM
(setq SS1 (ssname SS SSN)
SSN (1+ SSN)
MOVE_PLIST (xz-box&mid SS1)
)
(vl-cmdf ".MOVE"
SS1
""
(nth MOVEPT MOVE_PLIST)
FILTER
basept
"@"
)
)
(command "_.ucs" "p" )
(vl-cmdf ".undo" "end")
(princ (strcat "\n -->共计移动 " (rtos SSM 2 0) " 个对象.")
)
)
)
(princ)
)
;;ALO
感谢 分享
支持支持，谢谢楼主分享
很好的程序支持一下！ 真奇怪.没支持. 我支持你！大力支持你！
选择用手机上，下不了！ 支持支持 新人，初来乍到
支持楼主分享！ 支持支持，谢谢楼主分享 学习 并进一步改进 收藏先。。。。。。。。。 本帖最后由 raimo 于 2011-6-19 07:22 编辑
试用之后发现很不错,非常实用的文字对齐工具,比我以前的还好用.
不仅仅是文字位置上的对齐,还能自动修改文字对齐属性,这点我很是赞同
就是还少了一个,现在都是文字垂直对齐的,如果能补上一个水平对齐就更加完美了..
里面的子程序能够轻松实现 楼上 的功能.
自己加吧.懒得弄.