左对齐文字

baitang36

;;;;;;;;;;;;;;;;;;;;左对齐文字 99.5.8 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:zdq (/ ss txpoint n index OLD72 new72 old11 new11 oldpoint newpoint entl ent type1  )
   (SETVAR "CMDECHO" 0)
  (princ "\n左对齐文字 (c)SYZ 1999.5.8\n请选择需对齐的字符串:")
  (setq ss (ssget))
  (setq txpoint (getpoint "\n输入左起始点: "))
  (setq n (sslength ss))
  (setq index 0)
    (repeat n
    (setq ent (entget (setq aaaa(ssname ss index))))
    (setq index (+ 1 index))
    (setq type1 (assoc 0 ent))
    (if (= "TEXT" (cdr type1))
      (progn
      (setq oldpoint (assoc 10 ent))
      (setq newpoint ( cons (car oldpoint)  (cons(car txpoint) (cdr (cdr oldpoint)))))
      (setq entl (subst newpoint oldpoint ent))
      (setq old72(ASSOC 72 ent))
      (setq new72(cons 72 (cdr(assoc 71 ent))))
      (setq entl (subst new72 old72 entl))
      (setq old11(ASSOC 11 ent))
      (setq new11(list 11 0.0 0.0 0.0))
      (setq entl (subst new11 old11 entl))
      ;(entdel aaaa)
      (entmod entl)
      )
    )
    (if (= "MTEXT" (cdr type1))
      (progn
      (setq oldpoint (assoc 10 ent))
      (setq newpoint ( cons (car oldpoint)  (cons(car txpoint) (cdr (cdr oldpoint)))))
      (setq entl (subst newpoint oldpoint ent))
      (setq old72(ASSOC 72 ent))
      (setq new72(cons 72 (cdr(assoc 71 ent))))
      (setq entl (subst new72 old72 entl))
      (setq old11(ASSOC 11 ent))
      (setq new11(list 11 0.0 0.0 0.0))
      (setq entl (subst new11 old11 entl))
      ;(entdel aaaa)
      (entmod entl)
      )
    )
)
(SETVAR "CMDECHO" 1)
   (prin1)
)

yoyoho

谢谢! baitang36 分享程序!!!!!!

bluefcc1

感謝分享!!!!

start4444

fangmin723

如下情况


执行完后就成这样了，还是需要优化一下！！！

xyp1964

1. ;; tt(左对齐)
   
2. (defun c:tt ()
   
3.   (setq i -1)
   
4.   (if (and (setq ss (ssget))
   
5.            (setq p0 (getpoint "\n左对齐基点<退出>: "))
   
6.       )
   
7.     (while (setq s1 (ssname ss (setq i (1+ i))))
   
8.       (setq p1 (xyp-9pt s1 1)
   
9.             p2 (list (car p0) (cadr p1))
   
10.       )
    
11.       (xyp-move s1 p1 p2)
    
12.     )
    
13.   )
    
14.   (princ)
    
15. )
    

;; tt(左对齐)<br /> (defun c:tt ()<br />   (setq i -1)<br />   (if (and (setq ss (ssget))<br />            (setq p0 (getpoint "\n左对齐基点<退出>: "))<br />       )<br />     (while (setq s1 (ssname ss (setq i (1+ i))))<br />       (setq p1 (xyp-9pt s1 1)<br />             p2 (list (car p0) (cadr p1))<br />       )<br />       (xyp-move s1 p1 p2)<br />     )<br />   )<br />   (princ)<br /> )<br />

fangmin723

xyp1964 发表于 2019-1-25 12:41

院长，你这个就别拿出来秀了，就算拿出来了，我们又用不了，功能再好，对不想装运行环境或者使用其他公司CAD的人来说，也就只能干瞪眼了

yoyoho

谢谢! xyp1964 版主分享思路!!!!!