设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 求---多个单行文字水平对齐 LISP
返回列表 发新帖
查看: 3535|回复: 5

[基础] 求---多个单行文字水平对齐 LISP

[复制链接]
feelg
发表于 2009-12-22 13:38:00 | 显示全部楼层 |阅读模式
有没有。用LISP.把多个单行文字进行按点或线进行水平对齐的。。编辑文字经常遇到。请各位帮一帮。谢啦。。
回复

使用道具 举报

xianaihua
发表于 2009-12-22 23:43:00 | 显示全部楼层
用Vlisp写了一个
  2. ;;;;文本水平对齐
  3. ;;;by:lihuili 2009-12-22
  4. (vl-load-com)
  5. (defun c:txt_hor_Alignment (/ Ent Obj InsPt ss TxtList item text_InsPt NewInsPt)
  6.   (setq Ent (entsel "\n 选择要对齐的参考文本(位置不变的文本): "))
  7.   (if (and
  8. Ent
  9. (= (value 0 (entget (car Ent))) "TEXT")
  10. (not (redraw (car Ent) 3))
  11.       )
  12.     (progn
  13.       (setq Obj (MakeX (car Ent)))
  14.       (if (= (vla-get-Alignment Obj) 0)
  15. (setq InsPt (safearray-value
  16.         (variant-value (vla-get-InsertionPoint Obj))
  17.       )
  18. )
  19. (setq
  20.    InsPt (safearray-value
  21.     (variant-value (vla-get-TextAlignmentPoint Obj))
  22.   )
  23. )
  24.       )
  25.       (prompt "\n选择其他与参考对齐的文本(要改变位置)!")
  26.       (if (setq ss (ssget '((0 . "TEXT"))))
  27. (progn
  28.    (setq TxtList (ss->Objlist ss))
  29.    (foreach item TxtList
  30.      (if (= (vla-get-Alignment item) 0)
  31.        (setq text_InsPt
  32.        (safearray-value
  33.          (variant-value (vla-get-InsertionPoint item))
  34.        )
  35.        )
  36.        (setq text_InsPt
  37.        (safearray-value
  38.          (variant-value
  39.     (vla-get-TextAlignmentPoint item)
  40.          )
  41.        )
  42.        )
  43.      )
  44.      (setq
  45.        InsPt (list (car text_InsPt)
  46.      (cadr InsPt)
  47.      (caddr InsPt)
  48.       )
  49.      )
  50.      (setq NewInsPt (vlax-3d-point InsPt))
  51.      (if (= (vla-get-Alignment item) 0)
  52.        (vla-put-InsertionPoint item NewInsPt)
  53.        (vla-put-TextAlignmentPoint item NewInsPt)
  54.      )
  55.      (redraw (car Ent) 4)
  56.    )
  57. )
  58.       )
  59.     )
  60.   )
  61.   (princ)
  62. )
  63. (defun VALUE (num ent /)
  64. (cdr (assoc num ent))
  65. )
  66. (defun MakeX (entname)
  67. (vlax-ename->vla-object entname)
  68. )
  69. (defun ss->Objlist (ss / RtnList temp1)
  70.   (while (setq temp1 (ssname ss 0))
  71.     (setq RtnList (cons (vlax-ename->vla-object temp1) RtnList))
  72.     (ssdel temp1 ss)
  73.   )
  74.   RtnList
  75. )
  76.   
回复 支持 反对

使用道具 举报

ahill
发表于 2009-12-30 22:22:00 | 显示全部楼层
我以前写过一个，可以X和Y向都可以选择用的，你看一下吧。
  2. (defun c:tta(/ txtsel TXTSEL_Num basept basetxt xcoor_basept ycoor_basept txtmb
  3.       dokey i txti txtnew txti_pt xcoor_txti ycoor_txti txti_pt_new )
  4.    (princ "\n文本自动对齐!Design by Ahill!Copyright@2007\n")
  5.    (setvar "cmdecho" 0)
  6.    (princ "\n请选择欲对齐的文本实体(自动滤去非文字实体):")
  7.    (while (if
  8.     (SETQ txtsel (SSGET '((-4 . "<OR" )(0 . "TEXT") (0 . "MTEXT")(-4 . "OR>"))))
  9.      T
  10.      nil)
  11. (SETQ TXTSEL_Num (sslength txtsel))
  12.     (if     (not (setq basept (getpoint "\n点取对齐点<选取参照文字实体>: ")))
  13.   (progn
  14.      (princ "\n选取参照文字实体:")
  15.      (SETQ basetxt (SSGET '((-4 . "<OR" )(0 . "TEXT") (0 . "MTEXT")(-4 . "OR>"))))
  16.      (if (= (cdr (assoc 0 (entget (ssname basetxt 0)))) "MTEXT")
  17.       (progn
  18.        (setq basept (cdr (assoc 10 (entget (ssname basetxt 0)))))
  19.       )
  20.    
  21.      (progn
  22.     (setq mb72 (cdr (assoc 72 (entget (ssname basetxt 0)))))
  23.     (setq mb73 (cdr (assoc 73 (entget (ssname basetxt 0)))))
  24.            (if (or (/= 0 mb72) (/= 0 mb73))
  25.      (setq basept (cdr (assoc 11 (entget (ssname basetxt 0)))))
  26.     )
  27.     (if (and (= 0 mb72) (= 0 mb73))  
  28.        (setq basept (cdr (assoc 10 (entget (ssname basetxt 0))))) ;获取基准文字座标
  29.       )
  30.      )
  31.      )
  32.   )
  33. )
  34.    (setq xcoor_basept (car basept))
  35.    (setq ycoor_basept (cadr basept))
  36. (if (not (setq dokey (getint "\n输入对齐方向 <1>沿X方向对齐 / <2>沿Y方向对齐 <2>:")))
  37.     (setq dokey 2)
  38.   )
  39.    (setq i 0)
  40.    (repeat TXTSEL_Num  
  41.    
  42.   (setq txti (entget (ssname txtsel i)))  
  43.    
  44.     (setq mb72 (cdr (assoc 72  txti )))
  45.   (setq mb73 (cdr (assoc 73  txti )))
  46.    
  47.   (if (and (or (/= 0 mb72) (/= 0 mb73)) (/= (cdr (assoc 0 txti)) "MTEXT"))
  48.      (progn
  49.       (setq txti_pt (cdr (assoc 11  txti )))
  50.       (setq txtmb 11)
  51.    )
  52.   )
  53.   (if (or (and (= 0 mb72) (= 0 mb73)) (= (cdr (assoc 0 txti)) "MTEXT"))
  54.      (progn
  55.       (setq txti_pt (cdr (assoc 10 txti )))
  56.       (setq txtmb 10)
  57.      )
  58.   )
  59.    
  60.    
  61.     (setq xcoor_txti (car txti_pt))
  62.     (setq ycoor_txti (cadr txti_pt))
  63.     (if (= dokey 2)
  64.      (progn
  65.       (setq txti_pt_new (list xcoor_txti ycoor_basept (caddr txti_pt)))
  66.      )
  67.   )
  68.     (if (= dokey 1)
  69.      (progn
  70.       (setq txti_pt_new (list xcoor_basept ycoor_txti  (caddr txti_pt)))
  71.      )
  72.   )
  73.     (setq txti_pt_new (cons txtmb (list (car txti_pt_new) (cadr txti_pt_new) (caddr txti_pt_new))))
  74.     (setq txti_pt (cons txtmb (list (car txti_pt) (cadr txti_pt) (caddr txti_pt))))
  75.     (setq txtnew (subst txti_pt_new txti_pt txti))
  76.     (entmod txtnew)
  77.     (setq i (+ 1 i))
  78. )
  79.      (princ "\n请选择欲对齐的文本实体(自动滤去非文字实体):")
  80.      )
  81.   (setvar "cmdecho" 1)
  82.   (princ)
  83. )
  84. (princ "\n TTA:文本对齐!Design by Ahill!Copyright@2007")
回复 支持 反对

使用道具 举报

feelg
 楼主| 发表于 2010-1-25 21:00:00 | 显示全部楼层

谢谢，两位兄台了。

回复 支持 反对

使用道具 举报

waterchen
发表于 2010-12-9 14:52:46 | 显示全部楼层
谢谢2位前辈的分享!
回复 支持 反对

使用道具 举报

xiaxiang
发表于 2010-12-9 15:34:33 | 显示全部楼层
非常好，感谢分享
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-10-2 16:16 , Processed in 0.188171 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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