关于文本对齐插入点的修改方法
;;;;;本代码来源于论坛，用于文本对齐，程序对齐插入点为首行文字，不是很方便，试了多次想通过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 0lst '())
(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)
) 已经，解决啦
页:
[1]