sqqr 发表于 2005-3-11 12:08:00

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

<FONT face=宋体><FONT face=宋体>请问：如何实现下面的lisp对尺寸实测值及修改后的尺寸有效，且支持多选对象？？？</FONT></FONT>



<FONT face=宋体><FONT face=宋体>下面的lisp仅对字符串有效！</FONT></FONT>





<FONT face=宋体></FONT>       


<FONT face=宋体><FONT face=宋体>文字加括号<BR><FONT face=宋体>;字符串前后加括号<BR>;2004.10.21<BR>;<BR><BR>;----------------------------------------------------------------------------------<BR>(defun c:r_jkh()<BR>　(princ " 字加括号 --&gt; 阮春辉　Email:ruan_gdqf@sina.com")<BR>(setq a (entsel "\n请选择文字：")<BR>a1 (entget(car a))<BR>a2 (assoc 1 a1)<BR>string1 (cdr a2)<BR>)<BR>(setq string (strcat "(" string1 ")")<BR>a1 (subst (cons 1 string) a2 a1)<BR>)<BR>(entmod a1)<BR>(princ)<BR>)<BR>


</FONT></FONT></FONT>

yoyoho 发表于 2013-1-3 21:49:38

【KAIXIN】 发表于 2011-12-13 09:49 static/image/common/back.gif
可以加上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 发表于 2005-3-11 12:46:00

如果是未修改的尺寸，那(assoc 1 a1) 得到是(1 . "")，所以string1得到的是"",只要加个判断，比如


(if (/= string1 "")<BR>       (setq        string (strcat "(" string1 ")")<BR>        a1                               (subst (cons 1 string) a2 a1)<BR>       )<BR>       (setq string "(&lt;&gt;)")<BR>)<BR><BR><BR>

龙龙仔 发表于 2005-3-11 17:23:00

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

sqqr 发表于 2005-3-11 21:11:00

谢谢 LUCAS ！！


不足之处


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

无痕 发表于 2005-3-12 16:37:00

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

【KAIXIN】 发表于 2011-12-13 09:49:55

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

可以加上MTEXT吗？
页: [1]
查看完整版本: 龙龙仔请进： 文字加括号lisp