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 <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))
    )

   )

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

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

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

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

好多函数 都不认识

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

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

貌似看懂了一些

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

感谢楼主分享
页: [1] 2
查看完整版本: 求做这种对齐效果