改写本坛大侠一个很有价值的代码
本帖最后由 尘缘一生 于 2021-11-2 09:12 编辑原帖地址为：
http://bbs.mjtd.com/forum.php?mo ... %D7%F3%BC%D3&page=1
http://bbs.mjtd.com/forum.php?mo ... %D3%D2%BC%FC&page=1
缺少的函数请到原帖下载即可：
[*];;modify by 尘缘一生QQ 15290049
[*];;汉字、序号、字符左加右减
[*](defun c:tt (/ loop pt ptt ent_sl en)
[*](princ "\n 请点选要修改的 (汉字、序号、字符)(左键+1 右键-1)")
[*](setq loop T)
[*](while loop
[*] (setq pt (grread t 15 2))
[*] (setq ptt (cadr pt))
[*] (cond
[*] ((equal (car pt) 5);;移动
[*] (if (setq ent_sl (nentselp ptt))
[*] (setq en (car ent_sl))
[*] )
[*] )
[*] ((and (equal (car pt) 3) en);左键
[*] (jj-str ent_sl 1)
[*] (setq loop T)
[*] )
[*] ((and (or (equal (car pt) 11) (equal (car pt) 25)) en);右键
[*] (jj-str ent_sl -1)
[*] (setq loop T)
[*] )
[*] ((and (or (equal (car pt) 11) (equal (car pt) 25) (equal (car pt) 3)) (= en nil))
[*] (setq loop nil)
[*] )
[*] )
[*])
[*])
[*];;汉字、序号、字符左加右减--------(一级)--------------
[*];;ent_sl entsel选择num 步距 1 -1
[*](defun jj-str (ent_sl num / en ent e str str1 string strascii pt newe ty)
[*](setq en (car ent_sl) pt (cadr ent_sl))
[*](setq ty (dxf1 en 0))
[*](if (member ty '("TEXT" "MTEXT" "ATTRIB"))
[*] (progn
[*] (setq e (entlast))
[*] (wzcf (ssadd en)) ;;打断选择集文字
[*] (if (setq newe (car (nentselp pt)))
[*] (progn
[*] (setq ent (entget newe)) ;获取图元
[*] (setq str (cdr (assoc 1 ent))) ;读取数值
[*] (if (= num 1)
[*] (cond
[*] ((= str "零") (setq string "一"))
[*] ((= str "一") (setq string "二"))
[*] ((= str "二") (setq string "三"))
[*] ((= str "三") (setq string "四"))
[*] ((= str "四") (setq string "五"))
[*] ((= str "五") (setq string "六"))
[*] ((= str "六") (setq string "七"))
[*] ((= str "七") (setq string "八"))
[*] ((= str "八") (setq string "九"))
[*] ((= str "九") (setq string "十"))
[*] ((= str "十") (setq string "零"))
[*] ((= str "左") (setq string "右"))
[*] ((= str "右") (setq string "左"))
[*] ((= str "上") (setq string "下"))
[*] ((= str "下") (setq string "上"))
[*] ((= str "东") (setq string "南"))
[*] ((= str "南") (setq string "西"))
[*] ((= str "西") (setq string "北"))
[*] ((= str "北") (setq string "东"))
[*] )
[*] (cond
[*] ((= str "零")(setq string "十"))
[*] ((= str "一")(setq string "零"))
[*] ((= str "二")(setq string "一"))
[*] ((= str "三")(setq string "二"))
[*] ((= str "四")(setq string "三"))
[*] ((= str "五")(setq string "四"))
[*] ((= str "六")(setq string "五"))
[*] ((= str "七")(setq string "六"))
[*] ((= str "八")(setq string "七"))
[*] ((= str "九")(setq string "八"))
[*] ((= str "十")(setq string "九"))
[*] ((= str "左")(setq string "右"))
[*] ((= str "右")(setq string "左"))
[*] ((= str "上")(setq string "下"))
[*] ((= str "下")(setq string "上"))
[*] ((= str "东")(setq string "北"))
[*] ((= str "南")(setq string "东"))
[*] ((= str "西")(setq string "南"))
[*] ((= str "北")(setq string "西"))
[*] )
[*] )
[*] (cond
[*] ((< 47 (setq strascii (ascii str)) 58)
[*] (if (> (+ num strascii) 57)
[*] (setq string (chr 48))
[*] (setq string (chr (+ num strascii)))
[*] )
[*] )
[*] ((< 64 strascii 91)
[*] (if (> (+ num strascii) 90)
[*] (setq string (chr 65))
[*] (setq string (chr (+ num strascii)))
[*] )
[*] )
[*] ((< 96 strascii 123)
[*] (if (> (+ num strascii) 122)
[*] (setq string (chr 97))
[*] (setq string (chr (+ num strascii)))
[*] )
[*] )
[*] (t (princ "\n 非数值或字母!") (setq string str))
[*] )
[*] (setq ent (subst (cons 1 string) (assoc 1 ent) ent))
[*] (entmod ent)
[*] )
[*] )
[*] (wzhb (last_ent e));;一次归并
[*] (wzhb (SL:PickSet-fromList (list (entlast))));;归并最后实体
[*] ) ;progn
[*] ;;(slddcht en) ;;三领DCL文字修改，可以注销
[*]);if
[*])
楼主好有激情，谢谢楼主分享好程序。
方便帮修复一下下面的帖子的程序吗
http://bbs.mjtd.com/thread-183522-1-1.html 本帖最后由 尘缘一生 于 2021-11-4 11:16 编辑
669423907 发表于 2021-11-1 22:12
楼主好有激情，谢谢楼主分享好程序。
方便帮修复一下下面的帖子的程序吗
http://bbs.mjtd.co ...
自动图层，还是尽量别用了。不好遇见后果。
下面：继续完善，增加对钢筋的支持。。。。。。
[*]
[*];;末尾字母加 (strendisabc+ "az" 2)-----(一级)----
[*](defun strendisabc+ (str n / s2 as0 as2)
[*](if (wcmatch str "*")
[*] (progn
[*] (setq s2 (substr str (strlen str)) n (fix n))
[*] (setq as0 (ascii s2) as2 (+ (ascii s2) n))
[*] (cond
[*] ((and (>= as0 97) (< as2 97)) (setq s2 "z"))
[*] ((and (>= as0 65) (< as2 65)) (setq s2 "Z"))
[*] ((and (<= as0 122) (> as2 122)) (setq s2 "a"))
[*] ((and (<= as0 90) (> as2 90)) (setq s2 "A"))
[*] (T (setq s2 (chr (+ (ascii s2) n))))
[*] )
[*] (strcat (substr str 1 (1- (strlen str))) s2)
[*] )
[*])
[*])
[*];末尾数字加--------------(一级)------------
[*](defun strendisnum+ (str n / s1 l)
[*](if (wcmatch str "*#")
[*] (progn
[*] (setq s1 "")
[*] (while (not (numberp (vl-catch-all-apply 'read (list str))))
[*] (setq s1 (strcat s1 (substr str 1 1)))
[*] (setq str (substr str 2))
[*] );多行文字可能只能读一行，失误
[*] (setq l (strlen str) str (vl-princ-to-string (+ n (read str))))
[*] (repeat (- l (strlen str)) (setq str (strcat "0" str)))
[*] (strcat s1 str)
[*] )
[*])
[*])
[*];;图元文本加----------------(一级)-----------------------
[*](defun entext+ (ob n / str str1)
[*](and (wcmatch (vla-get-ObjectName ob) "*Text")
[*] (setq str (vla-get-TextString ob))
[*] (not (wcmatch str "*\\P*,*\n*,*\t*"))
[*] (or (setq str1 (strendisnum+ str n)) (setq str1 (strendisabc+ str n)))
[*] (vla-put-TextString ob str1)
[*])
[*])
[*];;modify by 尘缘一生QQ 15290049
[*];;汉字序号、钢筋、字符-->左加右减 c:jjstr
[*]
[*](defun c:tt (/ loop pt ptt ensl e_lst)
[*](setq e_lst (sysvar '("osmode" "cmdecho" "ORTHOMODE")))
[*](princ "\n 请点选要修改的 (汉字序号、钢筋、字符)(左升+1 右降-1)")
[*](setvar "cmdecho" 0)
[*](setvar "OSMODE" 0)
[*](setvar "ORTHOMODE" 0)
[*](_Undo1)
[*](setq loop T)
[*](while loop
[*] (setq pt (grread t 15 2))
[*] (setq ptt (cadr pt))
[*] (cond
[*] ((equal (car pt) 5);;移动
[*] (setq ensl (nentselp ptt))
[*] )
[*] ((and (equal (car pt) 3) ensl);左键
[*] (jj-str ensl 1)
[*] (setq loop T ensl nil)
[*] )
[*] ((and (or (equal (car pt) 11) (equal (car pt) 25)) ensl);右键
[*] (jj-str ensl -1)
[*] (setq loop T ensl nil)
[*] )
[*] ((and (or (equal (car pt) 11) (equal (car pt) 25) (equal (car pt) 3)) (= ensl nil))
[*] (setq loop nil)
[*] )
[*] )
[*])
[*](_Undo2)
[*](mapcar 'eval e_lst)
[*])
[*];;汉字序号、钢筋、字符-->左加右减--------(一级)--------------
[*];;ent_sl entsel选择num 步距 1 -1
[*](defun jj-str1 (ent_sl num / en ent e str string pt newe ty)
[*](setq en (car ent_sl) pt (cadr ent_sl))
[*](setq ty (dxf1 en 0))
[*](if (member ty '("TEXT" "MTEXT" "ATTRIB"))
[*] (progn
[*] (setq e (entlast))
[*] (wzcf (ssadd en)) ;;打断选择集文字
[*] (if (setq newe (car (nentselp pt)))
[*] (progn
[*] (setq ent (entget newe)) ;获取图元
[*] (setq str (cdr (assoc 1 ent))) ;读取数值
[*] (if (= num 1)
[*] (cond
[*] ((= str "零") (setq string "一"))
[*] ((= str "一") (setq string "二"))
[*] ((= str "二") (setq string "三"))
[*] ((= str "三") (setq string "四"))
[*] ((= str "四") (setq string "五"))
[*] ((= str "五") (setq string "六"))
[*] ((= str "六") (setq string "七"))
[*] ((= str "七") (setq string "八"))
[*] ((= str "八") (setq string "九"))
[*] ((= str "九") (setq string "十"))
[*] ((= str "十") (setq string "零"))
[*] ((= str "左") (setq string "右"))
[*] ((= str "右") (setq string "左"))
[*] ((= str "上") (setq string "下"))
[*] ((= str "下") (setq string "上"))
[*] ((= str "东") (setq string "南"))
[*] ((= str "南") (setq string "西"))
[*] ((= str "西") (setq string "北"))
[*] ((= str "北") (setq string "东"))
[*] )
[*] (cond
[*] ((= str "零")(setq string "十"))
[*] ((= str "一")(setq string "零"))
[*] ((= str "二")(setq string "一"))
[*] ((= str "三")(setq string "二"))
[*] ((= str "四")(setq string "三"))
[*] ((= str "五")(setq string "四"))
[*] ((= str "六")(setq string "五"))
[*] ((= str "七")(setq string "六"))
[*] ((= str "八")(setq string "七"))
[*] ((= str "九")(setq string "八"))
[*] ((= str "十")(setq string "九"))
[*] ((= str "左")(setq string "右"))
[*] ((= str "右")(setq string "左"))
[*] ((= str "上")(setq string "下"))
[*] ((= str "下")(setq string "上"))
[*] ((= str "东")(setq string "北"))
[*] ((= str "南")(setq string "东"))
[*] ((= str "西")(setq string "南"))
[*] ((= str "北")(setq string "西"))
[*] )
[*] )
[*] (if string
[*] (entmod (emod ent 1 string))
[*] (entext+ (en2obj newe) num) ;;图元文本加
[*] )
[*] )
[*] )
[*] (wzhb (last_ent e)) ;;合并
[*] ;; (wzhb (SL:PickSet-fromList (list (entlast)))) ;;二次合并,合并函数取舍
[*] )
[*] ;; (slddcht en) ;;集成块内DCL修改等其他
[*])
[*])
请问与原贴比，修订或改进了哪些功能? 希望增加对罗马数字的支持 再版：
罗马字符支持其实很简单，加上即可，这个问题，到此可以了。
但是，还是不支持块、标注，需要打散炸开。
[*];;汉字序号、钢筋、字符-->左加右减------【开始】--------
[*]
[*];;ent_sl entsel选择num 步距 1 -1
[*](defun jj-str1 (ent_sl num / en ent e str string pt newe)
[*](setq en (car ent_sl) pt (cadr ent_sl))
[*](setq e (entlast))
[*](wzcf (ssadd en))
[*](if (setq newe (car (nentselp pt)))
[*] (progn
[*] (setq ent (entget newe))
[*] (setq str (cdr (assoc 1 ent)))
[*] (if (= num 1)
[*] (cond
[*] ((= str "零") (setq string "一"))
[*] ((= str "一") (setq string "二"))
[*] ((= str "二") (setq string "三"))
[*] ((= str "三") (setq string "四"))
[*] ((= str "四") (setq string "五"))
[*] ((= str "五") (setq string "六"))
[*] ((= str "六") (setq string "七"))
[*] ((= str "七") (setq string "八"))
[*] ((= str "八") (setq string "九"))
[*] ((= str "九") (setq string "十"))
[*] ((= str "十") (setq string "零"))
[*] ((= str "左") (setq string "右"))
[*] ((= str "右") (setq string "左"))
[*] ((= str "上") (setq string "下"))
[*] ((= str "下") (setq string "上"))
[*] ((= str "东") (setq string "南"))
[*] ((= str "南") (setq string "西"))
[*] ((= str "西") (setq string "北"))
[*] ((= str "北") (setq string "东"))
[*] )
[*] (cond
[*] ((= str "零")(setq string "十"))
[*] ((= str "一")(setq string "零"))
[*] ((= str "二")(setq string "一"))
[*] ((= str "三")(setq string "二"))
[*] ((= str "四")(setq string "三"))
[*] ((= str "五")(setq string "四"))
[*] ((= str "六")(setq string "五"))
[*] ((= str "七")(setq string "六"))
[*] ((= str "八")(setq string "七"))
[*] ((= str "九")(setq string "八"))
[*] ((= str "十")(setq string "九"))
[*] ((= str "左")(setq string "右"))
[*] ((= str "右")(setq string "左"))
[*] ((= str "上")(setq string "下"))
[*] ((= str "下")(setq string "上"))
[*] ((= str "东")(setq string "北"))
[*] ((= str "南")(setq string "东"))
[*] ((= str "西")(setq string "南"))
[*] ((= str "北")(setq string "西"))
[*] )
[*] )
[*] (if string
[*] (entmod (emod ent 1 string))
[*] (entext+ (en2obj newe) num)
[*] )
[*] )
[*])
[*](wzhb (last_ent e))
[*])
[*];;依据-->实体类型：汉字序号、钢筋、字符-->左加右减-----
[*];;en 实体名num 步距 1 -1
[*](defun jj-str (ensl num / enam ty ensl1 p0)
[*](setq enam (car ensl) p0 (cadr ensl) ty (dxf1 enam 0))
[*](cond
[*] ((or (= ty "TEXT") (= ty "TCH_TEXT"))
[*] (jj-str1 ensl num)
[*] )
[*] ((or (= ty "MTEXT") (= ty "TCH_MTEXT"))
[*] (command "EXPLODE" enam)
[*] (setq ensl1 (nentselp p0))
[*] (jj-str1 ensl1 num)
[*] )
[*] ((= ty "ATTDEF")
[*] (att2txt (SL:PickSet-fromList (list enam)))
[*] (setq ensl1 (nentselp p0))
[*] (jj-str1 ensl1 num)
[*] )
[*])
[*])
[*];;主程序-------------------------------------------
[*](defun c:jjstr (/ loop pt ptt ensl e_lst)
[*](setq e_lst (sysvar '("osmode" "cmdecho" "ORTHOMODE")))
[*](princ "\n 请点选要修改的 (汉字序号、钢筋、字符) (左升+1 右降-1)")
[*](setvar "cmdecho" 0)
[*](setvar "OSMODE" 0)
[*](setvar "ORTHOMODE" 0)
[*](_Undo1)
[*](setq loop T)
[*](while loop
[*] (setq pt (grread t 15 2))
[*] (setq ptt (cadr pt))
[*] (cond
[*] ((equal (car pt) 5);;移动
[*] (setq ensl (nentselp ptt))
[*] )
[*] ((and (equal (car pt) 3) ensl);左键
[*] (jj-str ensl 1)
[*] (setq loop T ensl nil)
[*] )
[*] ((and (or (equal (car pt) 11) (equal (car pt) 25)) ensl);右键
[*] (jj-str ensl -1)
[*] (setq loop T ensl nil)
[*] )
[*] ((and (or (equal (car pt) 11) (equal (car pt) 25) (equal (car pt) 3)) (= ensl nil))
[*] (setq loop nil)
[*] )
[*] )
[*])
[*](_Undo2)
[*](mapcar 'eval e_lst)
[*])
[*];;汉字序号、钢筋、字符-->左加右减------【结束】-----------
错误: no function definition: SYSVAR
请问这个啥错误？原贴也没有这个参数。 大佬，比如异形状，方形等，写一个程序批量清角，让位的LSP程序呗 错误: no function definition: SYSVAR
原帖中没找到这个函数，请问楼主，哪里可以找到啊。
页:
[1]
2