鼠标左右键加减文字修改的源码 - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区 - 第2页

longer1000 发表于 2012-2-24 09:04:49

非常感谢

江湖远人 发表于 2012-2-27 07:42:22

这个问题很有趣啊！收藏了，好好学学

icefire 发表于 2012-2-28 17:17:54

思路不错，值得学习

清风明月名字 发表于 2012-5-29 10:41:54

谢谢楼主，很有借鉴意义

tm0202 发表于 2013-4-23 17:27:21

这个看起来不错

yz_bs_jj 发表于 2023-5-7 20:20:55

plusminus命令，不错。保存为txt ，改名lsp，加载后很好用，对序号很好

小毛草 发表于 2023-5-8 22:46:44

这个更好用，原程序为其它网友提供！版权属于它的！

(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)
)

页: 1 [2]

明经CAD社区's Archiver