程序改后不稳定，求助
下面是一个对齐表格的程序，我想在左对齐的时候，在文字全面加一空格，目的是让文字离开左边线一点。多数都可以，但有时侯会有某几处的没有加上空格，然后把他重新对中再对左，又可以了。请大师们帮看看哪里出问题了？或者要怎么改进一下？;对象左中/正中对齐于容器框格 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"))) i0 )
(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)))
) 补上
(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")))
i0
)
(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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
页:
[1]