程序改后不稳定，求助

669423907

下面是一个对齐表格的程序，我想在左对齐的时候，在文字全面加一空格，目的是让文字离开左边线一点。多数都可以，但有时侯会有某几处的没有加上空格，然后把他重新对中再对左，又可以了。请大师们帮看看哪里出问题了？或者要怎么改进一下？

;对象左中/正中对齐于容器框格 yrgui QQ:1420428782 http://bbs.mjtd.com/thread-85506-1-1.html
(defun c:xaa(/ sSet key ola n ename e box)
(setvar"clayer" "0")
  (vl-load-com)
  (setvar "cmdecho" 0)
  (princ "\n选择要对齐的对象:")
  (setq sset (ssget ":S" '((0 . "*TEXT"))) i  0 )

(princ"\n左键 左中，右键 正中")
(setq gouzaoxian (grread))
(cond
((=(car gouzaoxian)3)  (setq key "A") (c:sc_kg) (c:tj_kg)) ;左键3
((=(car gouzaoxian)25) (setq key "X") (c:sc_kg))          ;右键25
)

;  (initget "X A")
;  (setq key (getkword "\n文本对齐于 [正中(X)/左中(A)]:<X>"))
;  (if (not key) (setq key "X"))

  (setq n 0)
  (setq ola (getvar "clayer"))
  ;生成临时图层，
  ;因为boundary会产生不可预料的对象，
  ;放在临时图层最后一起删掉
(command "undo" "be")
(vl-cmdf "layer" "M" "居中" "c" "1" "" "lw" "1" "" "l" "Continuous" "" "p" "n" "" "")
(setq la (getvar"clayer"))

  (repeat (setq m (sslength sSet))
    (princ (strcat "\n已完成" (itoa (1+ n)) "/" (itoa m) "，请稍候……"))
    (setq ename (ssname sSet n))
    (setq e (vlax-ename->vla-object ename))
    (vl-cmdf "boundary" "a" "o" "p" "" (getmcp e) "")
    (setq box (entlast))
    (if (= "TEXT" (cdr (assoc 0 (entget ename)))) ;单行文字
      (progn                           
        (if (= key "A")
          (progn
            (vlax-put-property e 'Alignment acAlignmentMiddleLeft)
            (vla-move e (vlax-3d-point (getmlp e)) (vlax-3d-point (getmlp box)))
          )
        )

        (if (= key "X")
          (progn                     
            (vlax-put-property e 'Alignment acAlignmentMiddleCenter)
            (vla-move e (vlax-3d-point (getmcp e)) (vlax-3d-point (getmcp box)))
          )
        )                           
      )
    );(if (= "TEXT"
    (if (= "MTEXT" (cdr (assoc 0 (entget ename))))  ;多行文字
      (progn                           
        (vlax-put-property e 'Width 0)
        (if (= key "A")
          (progn                     
            (vlax-put-property e 'AttachmentPoint acAttachmentPointMiddleLeft)
            (vla-move e (vlax-3d-point (getmlp e)) (vlax-3d-point (getmlp box)))
          )
        )
        (if (= key "X")
          (progn                     
            (vlax-put-property e 'AttachmentPoint acAttachmentPointMiddleCenter)
            (vla-move e (vlax-3d-point (getmcp e)) (vlax-3d-point (getmcp box)))
          )
        )                           
      )                             
    );(if (= "MTEXT"                             
    (entdel box)
    (setq n (1+ n))
  ) ;(repeat (setq m                                
  (setvar "clayer" ola)
  (vl-cmdf "laydel" "N" "居中" "" "Y")
  (princ "\n\n操作完成，谢谢使用")
  (princ "\n问题反馈：yrgui@yahoo.cn")
  (setvar "cmdecho" 1)
(command "undo" "e")
  (princ)
);(defun c:TextAlign         

;;功能:通获取对象左中点
(defun getmlp (e / p1 p2 x1 y1 z1 x2 y2 z2 plist)
  (if (= (type e) 'ename)
    (setq e (vlax-ename->vla-object e))
  )
  (vla-getboundingbox e 'p1 'p2)
  (setq p1 (vlax-safearray->list p1))
  (setq p2 (vlax-safearray->list p2))
  (setq x1 (car p1)
        y1 (cadr p1)
        z1 (caddr p1)
  )
  (setq x2 (car p2)
        y2 (cadr p2)
        z2 (caddr p2)
  )
  (setq plist (list x1 (/ (+ y1 y2) 2.0) (/ (+ z1 z2) 2.0)))
)

;;功能:获取对象正中点
(defun getmcp (e / p1 p2 x1 y1 z1 x2 y2 z2 plist)
  (if (= (type e) 'ename)
    (setq e (vlax-ename->vla-object e))
  )
  (vla-getboundingbox e 'p1 'p2)
  (setq p1 (vlax-safearray->list p1))
  (setq p2 (vlax-safearray->list p2))
  (setq x1 (car p1)
        y1 (cadr p1)
        z1 (caddr p1)
  )
  (setq x2 (car p2)
        y2 (cadr p2)
        z2 (caddr p2)
  )
  (setq plist (list (/ (+ x1 x2) 2.0) (/ (+ y1 y2) 2.0) (/ (+ z1 z2) 2.0)))
)

669423907

补上

(defun c:sc_kg();删除空格 ZZXXQQ http://bbs.mjtd.com/forum.php?mod=viewthread&tid=99165
;(PRINC "\Select Text(s) 选择文字 :")
(IF (SETQ SS (SSGET "p"'((1 . "* *")))) (PROGN
  (SETQ I -1)
  (REPEAT (SSLENGTH SS)
   (SETQ ENT (ENTGET (SSNAME SS (SETQ I (1+ I))))
  AA (CDR (ASSOC 1 ENT))
  CC ""
  J 0)
   (REPEAT (STRLEN AA)
    (IF (/= (SETQ TMP (SUBSTR AA (SETQ J (1+ J)) 1)) " ")
     (SETQ CC (STRCAT CC TMP))
    )
   )
   (SETQ ENT (SUBST (CONS 1 CC) (ASSOC 1 ENT) ENT))
   (ENTMOD ENT)
  )
))
(PRINC))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:tj_kg();添加空格 Andyhon 2012-6-28 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=95041
  (setq ss (ssget "p") ;;;;;;;;;;;;;;;;;;;;;;;; (setq ss (ssget "X" '((0 . "*TEXT") (1 . "*yz")))
        i  0
  )
  (while (setq ee (ssname ss i))
    (setq obj (vlax-ename->vla-object ee)
          txt (vla-get-textstring obj)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; txt (vl-string-subst "" " " txt)删后缀
          i   (1+ i)
    )
    (vla-put-textstring obj (strcat " " txt))加前缀
  )
(PRINC))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;