鼠标左右键加减文字修改的源码
本帖最后由 springwillow 于 2012-2-21 18:42 编辑偶然一个机会在群里看到了烈火大哥的一段关于用鼠标左右键实现对数字进行加减的代码，但是感觉和我的使用习惯不大一样。所以进行了一下修改，来给大家看看，水平不高，第一次在坛子里发这种技术贴。
(defun c:plusminus ( / pt en ent str ptt)
(while
(cond ((and(setq pt (grread t 4 2)) ;获取grread值
(equal (car pt) 5)
)
(progn
(setq ptt (cadr pt)
en(car (nentselp ptt))
)
t
)
)
((equal (car pt) 3) ;_Mouse Left button如果=3为左键
(if
(and(setq ent (entget en)) ;获取图元
(setq str (cdr (assoc 1 ent))) ;读取数值
(numberp (eval (read str)))
(equal (atoi str) (atof str))
)
(progn
(setq str (rtos (1+ (atoi str)) 2 0)) ;将数值加1
(setq ent (subst (cons 1 str) (assoc 1 ent) ent))
(entmod ent) ;更新实体数据库
)
)
)
((or (equal (car pt) 3) (equal (car pt) 25)) ;_Mouse Right button如果=11为右键
(if
(and
(setq ent (entget en));获取图元
(setq str (cdr (assoc 1 ent))) ;读取数值
(numberp (eval (read str)))
(equal (atoi str) (atof str))
)
(progn
(setq str (rtos (1- (atoi str)) 2 0)) ;将数值减1
(setq ent (subst (cons 1 str) (assoc 1 ent) ent))
(entmod ent) ;更新实体数据库
)
)
)
)
)
(princ)
)
这个更好用，原程序为其它网友提供！版权属于它的！
(defun c:qrr ( / *error* ang_text b_find badd bo2 box1 box2 dl e e1 e2 edata elist ell en ename ent etext f_width i i_length ipos lendelimiter lensource lst1 lstresult lstsource lstsub minx n newe pt ptt sdelimiter sname ss ss1 ssource str str_current str_defined str_given str_lst_return str_lst_temp str_lst_text str_text string string1 string2 strlst_defined strlst_defined2 text x lst elist right_change old_SHORTCUTMENU enable_change)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun *error* (msg)
(and id (unload_dialog id))
(and exprt (setvar 'expert exprt))
(and file (vl-file-delete file))
(if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
(princ (strcat "\程序函数被取消: " msg))
)
(princ)
)
(defun wzhb(ss /i ename dl ell x text e1 e2)
;(setq ss ss2)
(setq
i0
dl nil
minx nil
);setq
(if ss (progn(sssetfirst nil ss)))
(if (setq ss(ssget "P" '((0 . "TEXT"))))
(progn
(if (/= (sslength ss) 1)
(progn
(repeat (sslength ss)
(setq ename (ssname ss i)
ell (entget ename)
x (cadr (assoc 10 ell))
text (cdr (assoc 1 ell))
i (1+ i)
);setq
(setq dl (append dl (list (list x text ename))))
);repeat
(setq dl (vl-sort dl (function (lambda (e1 e2) (< (car e1) (car e2)))))
i 1
text(cadr (nth 0 dl))
ename (caddr (nth 0 dl))
ell (entget ename)
);setq
(repeat (- (length dl) 1)
(setq text (strcat text (cadr (nth i dl))))
(entdel (caddr (nth i dl)))
(setq i (1+ i))
);repeat
(setq ell (subst (cons 1 text) (assoc 1 ell) ell))
(entmod ell)
(entupd ename)
);progn
(progn
(setq ename(ssname ss 0))
(setq text (cdr(assoc 1 (entget ename))))
)
)
)
);if
;(princ)
(list ename text)
)
;=====================================================
;================= 文字打断 ===================
;=====================================================
;打断所有文字
(defun wzcf (ss /i n )
(if ss
(progn
(setvar "CMDECHO" 0)
(if (= 0 (boole 1 8 (getvar 'undoctl))) (command "_.undo" "_group"))
(setq i -1
n (sslength ss)
)
(while (< (setq i (1+ i)) n)
(if (and (setq ss2 (EF_Text:BreakAll (ssname ss i)) )
(>= (sslength ss2) 1)
)
(EF:PickSet-Group ss2 "文字炸开")
)
)
(if (= 8 (boole 1 8 (getvar 'undoctl))) (command "_.undo" "_end"))
)
)
)
;将ss成组
(defun EF:PickSet-Group (ss sName / )
(command "Group" "C" "*" sName ss "")
)
;文字打断所有
(defun EF_Text:BreakAll (eText;待炸开的文字
/
ss
edata
str_Text
str_lst_Text
ang_Text
pt
)
(setq ss (ssadd))
(setq edata (entget eText))
(setq str_Text (cdr (assoc 1 edata)))
(setq str_lst_Text (EF_Text:StringExplode str_Text)
) ;将字符串拆解成单字列表
(if (or (= (assoc 72 edata) 3);对齐方式对齐
(= (assoc 72 edata) 5);对齐方式拟合
)
(setq ang_Text (angle (cdr (assoc 10 edata)) (cdr (assoc 11 edata))))
(setq ang_Text (cdr (assoc 50 edata)))
)
(setq pt (cdr (assoc 10 edata)))
(setq edata (list '(0 . "TEXT")
(assoc 8 edata);图层
(assoc 40 edata);高度
(assoc 41 edata);宽度
(assoc 7 edata);样式
(assoc 71 edata);文字镜像
(cons 50 ang_Text);转角
(assoc 51 edata);倾角
)
)
(while str_lst_Text
(setq str_Current (car str_lst_Text))
(setq f_Width (EF_Text:getTextWidth str_Current edata))
;(EF-Text-PointWrite str_Current pt edata) ;按实际插入点填写文字
;;; (if (and (/= str_Current " ") (/= str_Current " "))
;;; (progn
(entmake (EF:List-SubstAssoc (list (cons 1 str_Current) (cons 10 pt)) edata T))
(setq ss (ssadd (entlast) ss))
;;;)
;;; )
(if (= (boole 1 (cdr (assoc 71 edata)) 2) 2)
(setq pt (polar pt ang_Text (- 0 f_Width)))
(setq pt (polar pt ang_Text f_Width))
)
(setq str_lst_Text (cdr str_lst_Text))
)
;(entdel eText);;;;修改
ss
)
;=============================================================;
;拆分字符串 ;
;EF_Text:StringExplode ;
;=============================================================;
;取得 空格 宽度
(defun EF_Text:getTextWidth (str;需要检测的字符串,如果为nil则取 edata
edata;需要检测的文字样式图元表
/
box1 bo2
)
(if (not str) (setq str (cdr (assoc 1 edata))))
(setq box1 (textbox (EF:List-SubstAssoc (list (cons 1 (strcat "m" str "m"))) edata T)))
(setq box2 (textbox (EF:List-SubstAssoc (list (cons 1 "mm")) edata T)))
(- (- (caadr box1) (caar box1))
(- (caadr box2) (caar box2))
)
)
;获取打断排除列表(单字符)
(defun EF_Text:getBreakDefined ( / )
(EF:String->List "%%130||%%131||%%132||%%133||%%134||%%135||%%136||%%p||%%P||%%c||%%C" "||")
)
;获取打断排除列表(成对字符)
(defun EF_Text:getBreakDefined2 ( / )
(mapcar '(lambda (e)
(EF:String->List e "*")
)
(EF:String->List "%%140*%%141||%%142*%%143||%%200*%%201||%%202*%%203||%%204*%%205" "||")
)
)
;字符串拆分
(defun EF_Text:StringExplode (str_Given ;需要转换的字符串
/
strlst_Defined;单定义字符例：'("%%130" "%%131" "%%132" "%%p" ...)
strlst_Defined2;成对定义字符 例 '((%%200 %%201) (%%202 %%203))
b_Find ;是否找到特殊字符串
str_Defined;特殊字符串
i_Length ;特殊字符串 长度
str_lst_Return;返回字符串列表
e
)
(setq strlst_Defined (EF_Text:getBreakDefined))
(setq strlst_Defined2 (EF_Text:getBreakDefined2))
;检查字符串首是否在特殊字符串列表中
(while (> (strlen str_Given) 0)
(setq b_Find nil)
;检查 单定义字符
(setq str_lst_Temp strlst_Defined)
(while (and str_lst_Temp (not b_Find))
(setq str_Defined (car str_lst_Temp ))
(setq i_Length (strlen str_Defined))
(if (= (substr str_Given 1 i_Length) str_Defined)
(setq b_Find T)
)
(setq str_lst_Temp (cdr str_lst_Temp))
)
;检查 成对定义字符
(setq str_lst_Temp strlst_Defined2)
(while (and str_lst_Temp (not b_Find))
(setq str_Defined (caar str_lst_Temp ))
(setq i_Length (strlen str_Defined))
(if (= (substr str_Given 1 i_Length) str_Defined)
(progn
(setq b_Find T)
(setq str_Defined (car str_lst_Temp))
)
)
(setq str_lst_Temp (cdr str_lst_Temp))
)
(cond (b_Find;特殊字符串
(progn
(if (equal (type str_Defined) 'STR)
(progn
(setq str_lst_Return (cons str_Defined str_lst_Return))
(setq str_Given (substr str_Given (1+ i_Length)))
)
(progn
(if (setq i (vl-string-search (cadr str_Defined) str_Given))
(progn
(setq e (substr str_Given 1 (+ i (strlen (cadr str_Defined)))))
(setq str_lst_Return (cons e str_lst_Return))
(setq str_Given (substr str_Given (+ 1 i (strlen (cadr str_Defined)))))
)
(progn
(setq str_lst_Return (cons (car str_Defined) str_lst_Return))
(setq str_Given (substr str_Given (1+ i_Length)))
)
)
)
)
)
)
((> (ascii (substr str_Given 1 1)) 128);大于128为汉字
(if (>= (atof (getvar "acadver")) 24)
(progn
(setq str_lst_Return (cons (substr str_Given 1 1) str_lst_Return))
(setq str_Given (substr str_Given 2))
)
(progn
(setq str_lst_Return (cons (substr str_Given 1 2) str_lst_Return))
(setq str_Given (substr str_Given 3))
)
)
)
(T
(setq str_lst_Return (cons (substr str_Given 1 1) str_lst_Return))
(setq str_Given (substr str_Given 2))
)
)
)
(reverse str_lst_Return)
)
;将字符串字符串以 给定 Key 分解成
;例：(EF:String->list "a,b,c" ",") →("a" "b" "c")
(defun EF:String->list (sSource sDelimiter / lenSource lenDelimiter iPos lstResult)
(if (= sDelimiter "") (progn (princ "EF:String->list 分割参数不能为空字符\"\"") (exit)))
(setq
lenSource (strlen sSource)
lenDelimiter (strlen sDelimiter)
)
(while (setq iPos (vl-string-search sDelimiter sSource))
(setq
lstResult (cons (substr sSource 1 iPos) lstResult)
sSource (substr sSource (+ 1 iPos lenDelimiter))
)
)
(reverse (cons sSource lstResult))
) ;_ end EF:String->list
;根据 lstSub 子表中的首元素 替换 lstSource 中对应表元
(defun EF:List-SubstAssoc (lstSub;需要替换的列表
lstSource;源列表
bAdd ;是否向源列表中追加 原本没有的元素
/
e1
)
(foreach e lstSub
(if (setq e1 (assoc (car e) lstSource))
(setq lstSource (subst e (assoc (car e) lstSource) lstSource))
(if bAdd (setq lstSource (append lstSource (list e))))
)
)
lstSource
)
;删除选择集
(defun EF:PickSet-Erase (ss/ e )
(while (> (sslength ss) 0)
(setq e (ssname ss 0))
(setq ss (ssdel e ss))
(entdel e)
)
)
;选择集并集
(defun EF:PickSet-Join (ss1;第一选择集
ss2;第二选择集
/ i n ename)
(setq i -1)
(setq n (sslength ss1))
(while (< (setq i (1+ i)) n)
(setq ss2 (ssadd (ssname ss1 i) ss2))
)
ss2
)
;选择集→元素列表
(defun EF:PickSet-toList ( ss/ i eList)
(setq i 0)
(if (equal (type ss) 'PICKSET)
(while (< i (sslength ss))
(setq eList (cons (ssname ss i) eList))
(setq i (1+ i))
)
)
eList
)
;元素列表→选择集
(defun EF:PickSet-fromList ( eList / ss )
(setq ss (ssadd))
(while eList
(if (equal (type (car eList)) 'ENAME)
(setq ss (ssadd (car eList) ss))
)
(setq eList (cdr elist))
)
ss
)
(defun *error*(msg)
(if right_change
(setvar "SHORTCUTMENU" old_SHORTCUTMENU)
)
)
(princ "\n请点选要修改的字符:(左键+1右键-1)")
(setq right_change nil)
(if (/=(getvar "SHORTCUTMENU") 11)
(progn
(setq old_SHORTCUTMENU (getvar "SHORTCUTMENU"))
(setvar "SHORTCUTMENU" 11)
(setq right_change T);;标记右键变量有更改过
)
)
(while
(cond
((and(setq pt (grread t 4 2)) ;获取grread值
(equal (car pt) 5);;移动鼠标
)
(progn
(setq ptt (cadr pt))
(setq ent_temp (nentselp ptt))
(setq en (car ent_temp))
(if (or
(and (=(length ent_temp)2)(= (cdr(assoc 0 (entget en))) "ATTRIB"))
(and (=(length ent_temp)2)(= (cdr(assoc 0 (entget en))) "TEXT"))
)
(setq enable_change T)
(setq enable_change nil)
)
t
)
)
((and (equal (car pt) 3) en);_Mouse Left button如果=3为左键;;;上次选择的en
(if enable_change
(progn
(setq ss (ssadd en))
(wzcf ss)
(redraw en 2);;redraw模式2隐藏图元
(setq lst1(EF:PickSet-toList ss2))
(setq newe(car(nentselp ptt)))
(if
(and (setq ent (entget newe)) ;获取图元
(setq str (cdr (assoc 1 ent))) ;读取数值
(cond
((< 47 (setq strascii (ascii str)) 58)
(if (> (1+ strascii) 57)
(setq string (chr 48))
(setq string (chr (1+ strascii)))
)
)
((< 64 strascii 91)
(if (> (1+ strascii) 90)
(setq string (chr 65))
(setq string (chr (1+ strascii)))
)
)
((< 96 strascii 123)
(if (> (1+ strascii) 122)
(setq string (chr 97))
(setq string (chr (1+ strascii)))
)
)
((= 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 "北"))
((= 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 "明"))
((= 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 "中"))
((= str "中")(setq string "低"))
((= str "低")(setq string "高"))
((= str "轻")(setq string "重"))
((= str "重")(setq string "轻"))
((= str "硬")(setq string "软"))
((= str "软")(setq string "硬"))
(t (princ "\n非数值或字母!")nil)
)
)
(progn
(setq ent (subst (cons 1 string) (assoc 1 ent) ent))
(entmod ent) ;更新实体数据库
)
)
(setq ss3(EF:PickSet-fromList lst1))
(setq lst(wzhb ss2))
(entdel (car lst))
(setq ss nil ss2 nil ss3 nil)
(setq elist(entget en))
(entmod (subst (cons 1 (cadr lst)) (assoc 1 elist) elist))
(entupd en)
(redraw en 1);;redraw模式2隐藏图元
)
(princ "\n错误提示--请选择 单行文字 或 属性块文字<<<<")
)
T;;继续循环
)
((and (or (equal (car pt) 11) (equal (car pt) 25)) en);_Mouse Right button如果=11为右键
(if enable_change
(progn
(setq ss (ssadd en))
(wzcf ss)
(redraw en 2);;redraw模式2隐藏图元
(setq lst1(EF:PickSet-toList ss2))
(setq newe(car(nentselp ptt)))
(if
(and (setq ent (entget newe)) ;获取图元
(setq str (cdr (assoc 1 ent))) ;读取数值
(cond
((< 47 (setq strascii (ascii str)) 58)
(if (< (1- strascii) 48)
(setq string (chr 57))
(setq string (chr (1- strascii)))
)
)
((< 64 strascii 91)
(if (< (1- strascii) 65)
(setq string (chr 90))
(setq string (chr (1- strascii)))
)
)
((< 96 strascii 123)
(if (< (1- strascii) 97)
(setq string (chr 122))
(setq string (chr (1- strascii)))
)
)
((= 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 "南"))
((= 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 "暗"))
((= 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 "中"))
((= str "中")(setq string "高"))
((= str "高")(setq string "低"))
((= str "重")(setq string "轻"))
((= str "轻")(setq string "重"))
((= str "软")(setq string "硬"))
((= str "硬")(setq string "软"))
(t (princ "\n非数值或字母!")nil)
)
)
(progn
(setq ent (subst (cons 1 string) (assoc 1 ent) ent))
(entmod ent) ;更新实体数据库
)
)
(setq ss3(EF:PickSet-fromList lst1))
(setq lst(wzhb ss2))
(entdel (car lst))
(setq ss nil ss2 nil ss3 nil)
(setq elist(entget en))
(entmod (subst (cons 1 (cadr lst)) (assoc 1 elist) elist))
(entupd en)
(redraw en 1);;redraw模式2隐藏图元
)
(princ "\n错误提示--请选择 单行文字 或 属性块文字<<<<")
)
T;;继续循环
)
)
)
(setq ss nil ss2 nil ss3 nil)
(if right_change
(setvar "SHORTCUTMENU" old_SHORTCUTMENU)
)
(princ)
)
plusminus命令，不错。保存为txt ，改名lsp，加载后很好用，对序号很好
你改过之后是个什么效果呢，能不能说一下？ 有意思，要是能支持多行文字就更好啦！ dfdfsdfsvnnk 发表于 2012-2-21 20:11 static/image/common/back.gif
你改过之后是个什么效果呢，能不能说一下？
原来是需要先选中对象，然后点鼠标左右键才能实现加减，改完之后可以直接在对象上点击左右键。试试就知道了。 本帖最后由 xzqk132 于 2012-2-22 11:30 编辑
不知springwillow大侠是否可以分享烈火兄的代码？谢谢
想学习一下
程序不错，这样的程序用在什么地方比较实用呢？ xzqk132 发表于 2012-2-22 11:30 static/image/common/back.gif
不知springwillow大侠是否可以分享烈火兄的代码？谢谢
想学习一下
;;;Writed by chlh_jd ;左键加1，右键减
1
(defun c:tt (/ en ent str pt)
(if (and (setq en (car (entsel "Select Integer Number Text :")))
(setq ent (entget en)) ;获取图元
(setq str (cdr (assoc 1 ent))) ;读取数值
(numberp (eval (read str)))
(equal (atoi str) (atof str))
)
(while (and (setq pt (grread t 4 2)) ;获取grread值
(not (and (= 2 (car pt)) ;排除回车和空格往下进行
(or (= 13 (cadr pt)) (= 32 (cadr pt)))
)
) ;_Enter Space
)
(cond ((= (car pt) 3) ;_Mouse Left button如果=3为左键
(setq str (rtos (1+ (atoi str)) 2 0)) ;将数值加1
(setq ent (subst (cons 1 str) (assoc 1 ent) ent))
(entmod ent) ;更新实体数据库
)
((or (= (car pt) 11) (= (car pt) 25)) ;_Mouse Right button如果=11为右键
(setq str (rtos (1- (atoi str)) 2 0)) ;将数值减1
(setq ent (subst (cons 1 str) (assoc 1 ent) ent))
(entmod ent) ;更新实体数据库
)
)
)
(princ)
)
(princ)
) 现在只支持纯数字，带小数点的也不行，要是能支持就好了，用处更大。。。不过还是非常感谢、、、 思路不错,支持一下 springwillow 发表于 2012-2-22 12:46 static/image/common/back.gif
非常感谢springwillow兄！
页:
[1]
2