关于文本对齐插入点的修改方法

yamjqq

;;;;;本代码来源于论坛，用于文本对齐，程序对齐插入点为首行文字，不是很方便，试了多次想通过getpoint指定插入点，没成功，求指点
  (defun c:test (/ e1 e2 ent heigh heighy i inpoint k lst ob ob_ptx ob_pty pt         pto ptx ss      )
   (setq ss (ssget '((0 . "text"))))
  (setq i 0  lst '()  )
  (repeat (sslength ss)
    (setq ent (ssname ss i))
    (setq inpoint (Vlax-Get (Vlax-Ename->Vla-Object ent) 'InsertionPoint))
    (setq lst (append    (list (cons ent inpoint))    lst        )    )
    (setq i (1+ i))
    )
  (setq lst (vl-sort lst
                     (function
                           (lambda (e1 e2)
                                     (< (caddr e1) (caddr e2))
                                     )
                           )
                     )
        )
  (setq ob_ptx (cadr (last lst)))
  (setq ob_pty (caddr (last lst)))
  (setq heigh (Vlax-Get (Vlax-Ename->Vla-Object (car (last lst))) 'Height))
  (setq k 0)
  (repeat (length lst)
    (setq ob (Vlax-Ename->Vla-Object (car (nth k lst))))
(setq pt (Vlax-Get ob 'InsertionPoint))
    (setq ptx (subst    ob_ptx    (car pt)    pt        )    )
    (setq heighy (- ob_pty (* 2.5 heigh (- (length lst) (1+ k)))))
     (setq pto (subst    heighy    (cadr ptx)    ptx        )    )
    (Vlax-Put-Property ob 'InsertionPoint (Vlax-3d-Point pto))
    (Vlax-Put-Property ob 'Height heigh)
    (setq k (1+ k))
    )
  (princ)
  )

yamjqq

已经，解决啦