求做这种对齐效果

dadiwusheng · 发表于 2016-3-31 11:14:54

效果如图

kozmosovia · 发表于 2016-3-31 11:14:55

本帖最后由 kozmosovia 于 2016-3-31 20:44 编辑

直接将边界图形与文字全选，自动判断边界图形的左右边

(Defun C:AdjText ( / _GetLeftRight ALI D40 EPT I LR NN SN SS SPT ST TXT)
(Defun _GetLeftRight (obj / LL UR)
(vla-getboundingbox (vlax-ename->vla-object obj) 'll 'ur)
(setq ll (trans (vlax-safearray->list ll) 0 1)
ur (trans (vlax-safearray->list ur) 0 1)
)
(list (car ll) (car ur))
)
(if (setq i -1
d40 0.0
lr (list 1e99 -1e99)
ss (ssget '((0 . "text,arc,circle,*line")))
)
(progn
(repeat (sslength ss)
(setq sn (ssname ss (setq i (1+ i)))
st (cdr (assoc 0 (entget sn)))
)
(if (= st "TEXT")
(setq d40 (max d40 (cdr (assoc 40 (entget sn))))
txt (cons sn txt)
)
(setq nn (_GetLeftRight sn)
lr (list (min (car lr) (car nn))
(max (cadr lr) (cadr nn))
)
)
)
)
(initget "Left Middle Right")
(setq
ali (getkword "\n Enter Alignment [Left/Middle/Right] <M>:")
)
(if (null ali)
(setq ali "Middle")
)
(setq d40 (* 0.5 d40))
(foreach sn txt
(setq nn (_GetLeftRight sn))
(cond ((= ali "Left")
(setq spt (car nn)
ept (+ d40 (car lr))
)
)
((= ali "Middle")
(setq spt (* 0.5 (+ (car nn) (cadr nn)))
ept (* 0.5 (+ (car lr) (cadr lr)))
)
)
((= ali "Right")
(setq spt (cadr nn)
ept (- (cadr lr) d40)
)
)
)
(command "_.Move" sn "" (list spt 0. 0.) (list ept 0. 0.))
)
)
)
)

(Defun C:AdjText ( / _GetLeftRight ALI D40 EPT I LR NN SN SS SPT ST TXT) 
  (Defun _GetLeftRight (obj / LL UR) 
    (vla-getboundingbox (vlax-ename->vla-object obj) 'll 'ur) 
    (setq ll (trans (vlax-safearray->list ll) 0 1) 
          ur (trans (vlax-safearray->list ur) 0 1) 
    ) 
    (list (car ll) (car ur)) 
  ) 
  (if (setq i        -1 
            d40        0.0 
            lr        (list 1e99 -1e99) 
            ss        (ssget '((0 . "text,arc,circle,*line"))) 
      ) 
    (progn 
      (repeat (sslength ss) 
        (setq sn (ssname ss (setq i (1+ i))) 
              st (cdr (assoc 0 (entget sn))) 
        ) 
        (if (= st "TEXT") 
          (setq        d40 (max d40 (cdr (assoc 40 (entget sn)))) 
                txt (cons sn txt) 
          ) 
          (setq        nn (_GetLeftRight sn) 
                lr (list (min (car lr) (car nn)) 
                         (max (cadr lr) (cadr nn)) 
                   ) 
          ) 
        ) 
      ) 
      (initget "Left Middle Right") 
      (setq 
        ali (getkword "\n Enter Alignment [Left/Middle/Right] <M>:") 
      ) 
      (if (null ali) 
        (setq ali "Middle") 
      ) 
      (setq d40 (* 0.5 d40)) 
      (foreach sn txt 
        (setq nn (_GetLeftRight sn)) 
        (cond ((= ali "Left") 
               (setq spt (car nn) 
                     ept (+ d40 (car lr)) 
               ) 
              ) 
              ((= ali "Middle") 
               (setq spt (* 0.5 (+ (car nn) (cadr nn))) 
                     ept (* 0.5 (+ (car lr) (cadr lr))) 
               ) 
              ) 
              ((= ali "Right") 
               (setq spt (cadr nn) 
                     ept (- (cadr lr) d40) 
               ) 
              ) 
        ) 
        (command "_.Move" sn "" (list spt 0. 0.) (list ept 0. 0.)) 
      ) 
    ) 
  ) 
)

被承包的东子 · 发表于 2016-3-31 16:51:20

本帖最后由被承包的东子于 2016-3-31 16:55 编辑

提供其中一种的实现，其余的参照修改就OK了！

(defun c:b1()
(setq line1 (car (entsel "选取左边的线")))
(setq line1_data (entget line1))
(setq x1 (cadr (assoc 10 line1_data)))
(setq line2 (car (entsel "选取右边的线")))
(setq line2_data (entget line2))
(setq x2 (cadr (assoc 10 line2_data)))
(setq ax (/ (+ x1 x2 ) 2))
(prompt "\n《框选文字》")
(setq ss (ssget))
(setq nq 0 k 0)
(setq mq (sslength ss) )
(repeat mq
(Setq en0 (ssname ss nq))
(setq txt_data (entget en0))
(setq old_zb_data (assoc 11 txt_data))
(setq old_zb_data1 (assoc 72 txt_data))
(setq new_zb_data1 (cons 72 1))
(setq txt_data (subst new_zb_data1 old_zb_data1 txt_data ))
(entmod txt_data)
(setq ty1 (cadr (cdr (assoc 10 txt_data))))
(setq new_zb (list ax ty1))
(setq new_zb_data (cons 11 new_zb))
(setq txt_data (subst new_zb_data old_zb_data txt_data ))
(entmod txt_data)
(setq nq (+ 1 nq))
)
)

(defun c:b1() 
 
 
  (setq line1 (car (entsel "选取左边的线"))) 
  (setq line1_data (entget line1)) 
   (setq x1 (cadr (assoc 10 line1_data))) 
  (setq line2 (car (entsel "选取右边的线"))) 
  (setq line2_data (entget line2)) 
   (setq x2 (cadr (assoc 10 line2_data))) 
  (setq ax (/ (+ x1 x2 ) 2)) 
 
  (prompt "\n《框选文字》") 
  (setq ss (ssget)) 
  (setq nq 0 k 0) 
   (setq mq (sslength ss) ) 
  (repeat mq 
  (Setq en0 (ssname ss nq)) 
 
 (setq txt_data (entget en0)) 
(setq old_zb_data (assoc 11 txt_data)) 
  (setq old_zb_data1 (assoc 72 txt_data)) 
     (setq new_zb_data1 (cons 72 1)) 
(setq txt_data (subst new_zb_data1 old_zb_data1 txt_data )) 
  (entmod txt_data) 
  (setq ty1 (cadr (cdr (assoc 10 txt_data)))) 
    
(setq new_zb (list ax ty1)) 
(setq new_zb_data (cons 11 new_zb)) 
 
(setq txt_data (subst new_zb_data old_zb_data txt_data )) 
(entmod txt_data) 
(setq nq (+ 1 nq)) 
    ) 
 
   )

dadiwusheng · 发表于 2016-3-31 23:36:40

谢谢啊，以后居中就不要这么累了

被承包的东子 · 发表于 2016-4-1 08:21:09

kozmosovia 发表于 2016-3-31 11:14
直接将边界图形与文字全选，自动判断边界图形的左右边

好多函数都不认识

军军cool · 发表于 2016-4-1 09:01:03

kozmosovia 发表于 2016-3-31 11:14
直接将边界图形与文字全选，自动判断边界图形的左右边

貌似看懂了一些

jackygaoping · 发表于 2016-4-2 11:53:31

感谢分享学习!!!!

yoyoho · 发表于 2016-4-2 22:58:35

学习了! 感谢分享程序!

冒个烟圈 · 发表于 2016-4-24 19:42:23

谢谢分享好程序，，，

王航 · 发表于 2016-5-9 12:39:12

感谢楼主分享

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

[已解答] 求做这种对齐效果

最佳答案

相关帖子