文字程序(源码)

LLXXZZ · 发表于 2011-6-15 18:10:55

文字程序
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_PLIST FILTER MOVEPT )
;(setq basept (getpoint))
(setq SSM (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

(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_PLIST  FILTER MOVEPT ) 
 
;(setq basept (getpoint))   
 
  (setq  SSM (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

wxynotes · 发表于 2025-4-20 17:03:02

感谢分享

paulpipi · 发表于 2019-8-16 10:22:39

支持支持，谢谢楼主分享

creatorzxz · 发表于 2025-4-19 13:34:02

很好的程序支持一下！

LLXXZZ · 发表于 2011-6-18 12:54:53

真奇怪.没支持.

669423907 · 发表于 2011-6-18 13:01:15

我支持你！大力支持你！
选择用手机上，下不了！

fengshi0519 · 发表于 2011-6-18 13:23:34

支持支持

xyxy · 发表于 2011-6-18 13:44:24

新人，初来乍到
支持楼主分享！

yxl88168 · 发表于 2011-6-18 21:41:40

支持支持，谢谢楼主分享

cumtjh · 发表于 2011-6-18 22:29:07

学习并进一步改进

zhb236623 · 发表于 2011-6-19 01:02:15

收藏先。。。。。。。。。

raimo · 发表于 2011-6-19 07:05:40

本帖最后由 raimo 于 2011-6-19 07:22 编辑

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

就是还少了一个,现在都是文字垂直对齐的,如果能补上一个水平对齐就更加完美了..

LLXXZZ · 发表于 2011-6-19 10:54:08

里面的子程序能够轻松实现楼上的功能.
自己加吧.懒得弄.

账号		自动登录	找回密码
密码			注册

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

评分