龙龙仔请进： 文字加括号lisp

sqqr

请问：如何实现下面的lisp对尺寸实测值及修改后的尺寸有效，且支持多选对象？？？ 下面的lisp仅对字符串有效！ 文字加括号
;字符串前后加括号
;2004.10.21
;

;----------------------------------------------------------------------------------
(defun c:r_jkh()
　(princ " 字加括号 --> 阮春辉　Email:ruan_gdqf@sina.com")
(setq a (entsel "\n请选择文字：")
a1 (entget(car a))
a2 (assoc 1 a1)
string1 (cdr a2)
)
(setq string (strcat "(" string1 ")")
a1 (subst (cons 1 string) a2 a1)
)
(entmod a1)
(princ)
)

yoyoho

【KAIXIN】 发表于 2011-12-13 09:49
可以加上MTEXT吗？

(defun c:tt () ;(setq e (car(entsel)))
(setq ss (ssget '((0 . "*TEXT,DIMENSION")))
i -1)
(while (setq e (ssname ss (setq i (1+ i))))
(setq obj (vlax-ename->vla-object e))
(if (OR (= "TEXT" (cdr(assoc 0 (entget e))))
        (= "MTEXT" (cdr(assoc 0 (entget e))))
    )
(vla-put-TextString obj (strcat "(" (vla-get-TextString obj)")"))
(vla-put-Textoverride obj (strcat "(" (if(wcmatch (setq dimt (vla-get-textoverride obj)) "")"<>" dimt) ")"))
)
)(princ)
)

ljpnb

如果是未修改的尺寸，那(assoc 1 a1) 得到是(1 . "")，所以string1得到的是"",只要加个判断，比如 (if (/= string1 "")
(setq string (strcat "(" string1 ")")
a1 (subst (cons 1 string) a2 a1)
)
(setq string "(<>)")
)

龙龙仔

;;By LUCAS
;;未详细测试
(defun C:R_JKH_LAI (/ ENT HOLDECHO HOLDOSMODE I N SS)
(vl-load-com)
(if (setq ENT (ssget '((0 . "DIMENSION,*TEXT"))))
(progn
(setq HOLDECHO (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq HOLDOSMODE (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq N (sslength ENT)
I 0
)
(while (< I N)
(setq SS (vlax-ename->vla-object (ssname ENT I)))
(cond
((wcmatch (vla-get-objectname SS) "*Dimension")
(cond
((= (vla-get-textoverride SS) "")
(vla-put-textoverride
SS
(strcat "(<>)")
)
)
((wcmatch (vla-get-textoverride SS) "*<>*")
(vla-put-textoverride
SS
(strcat "(" (vla-get-textoverride SS) ")")
)
)
(vla-put-textoverride
SS
(strcat "(" (rtos (vla-get-measurement SS) 2 2) ")")
)
)
)
(t
(vla-put-textstring
SS
(strcat "(" (vla-get-textstring SS) ")")
)
)
)
(setq I (1+ I))
)
(setvar "OSMODE" HOLDOSMODE)
(setvar "CMDECHO" HOLDECHO)
)
)
(princ)
)

sqqr

谢谢 LUCAS ！！


不足之处


对修改过尺寸数字的不起作用，遗憾－－

无痕

(defun c:tt() ;(setq e (car(entsel)))
(setq ss (ssget '((0 . "TEXT,DIMENSION")))
i -1)
(while (setq e (ssname ss (setq i (1+ i))))
(setq obj (vlax-ename->vla-object e))
(if (= "TEXT" (cdr(assoc 0 (entget e))))
(vla-put-TextString obj (strcat "(" (vla-get-TextString obj)")"))
(vla-put-Textoverride obj (strcat "(" (if(wcmatch (setq dimt (vla-get-textoverride obj)) "")"<>" dimt) ")"))
)
)(princ)
)

【KAIXIN】

无痕 发表于 2005-3-12 16:37
(defun c:tt()         ;(setq e (car(entsel)))         (setq ss (ssget '((0 . "TEXT,DIMENSION")))        i         -1)         (while (s ...

可以加上MTEXT吗？