【DZ】文字增减_v1.9——支持词组匹配+钢筋符号+罗马数字

kucha007 · 发表于 2023-5-29 21:35

本帖最后由 kucha007 于 2024-3-21 21:43 编辑

源程序出处：http://bbs.mjtd.com/forum.php?mo ... 794&fromuid=7329538

用了很久，非常好用。但也有一些小问题，就做了一些调整。

1-程序使用逻辑不变：目前支持单行文字+属性文字(源程序不支持)+块内属性文字。
2-汉字匹配方式做了调整，方便后面增加一些常用字符，有需要也可以自己改。
3-如果文字位于锁定的图层则无法编辑，这里做了判断，会弹窗提示。
主要会出现在块内属性文字和块外不随层的情况。
4-程序会临时关闭捕捉，避免选字时出错
5-支持四级钢筋符号，扩充特殊符号列表，避免文字分解错误。
6-支持词组匹配
7-支持单行且不带格式的多行属性文字

(setq Defined
(List
"%%130" "%%131" "%%132" "%%133" "%%134" ;1~4级钢筋符号+特殊钢筋
"%%135" "%%136" "%%137" "%%138" ;L型钢+H型钢+槽型钢+工字钢
"%%150" "%%151" "%%152" "%%153" "%%154" "%%155" "%%156" "%%157" "%%158" "%%159" ;罗马数字
"%%177" "%%p" "%%P" ;正负号
"%%c" "%%C" "%%D" "%%d" "%%%";直径符号+度数符号+%
'("%%140" "%%141") '("%%142" "%%143") ;上下标开关
'("%%200" "%%201") '("%%202" "%%203") '("%%204" "%%205") ;圆圈数字
)
)

;单字符列表:相同的字符不能重复出现,否则容易匹配错误
(setq OneSTRLst
(list
'("零" "壹" "贰" "叁" "肆" "伍" "陆" "柒" "捌" "玖" "拾" "佰" "仟" "萬" "億")
'("一" "二" "三" "四" "五" "六" "七" "八" "九" "十")
'("甲" "乙" "丙" "丁" "戊" "己" "庚" "辛" "壬" "癸")
'("㈠" "㈡" "㈢" "㈣" "㈤" "㈥" "㈦" "㈧" "㈨" "㈩") ;括号汉字
'("⑴" "⑵" "⑶" "⑷" "⑸" "⑹" "⑺" "⑻" "⑼" "⑽") ;括号数字
'("①" "②" "③" "④" "⑤" "⑥" "⑦" "⑧" "⑨" "⑩") ;圆圈数字
'("Ⅰ" "Ⅱ" "Ⅲ" "Ⅳ" "Ⅴ" "Ⅵ" "Ⅶ" "Ⅷ" "Ⅸ" "Ⅹ" "Ⅺ" "Ⅻ") ;罗马数字1-12大写
'("ⅰ" "ⅱ" "ⅲ" "ⅳ" "ⅴ" "ⅵ" "ⅶ" "ⅷ" "ⅸ" "ⅹ") ;罗马数字1-10小写
'("%%130" "%%131" "%%132" "%%133") ;钢筋符号
'("红" "橙" "黄" "绿" "青" "蓝" "紫")
'("前" "后" "左" "右" "上" "下")
'("东" "西" "南" "北" "中")
'("酸" "甜" "苦" "辣" "咸")
'("春" "夏" "秋" "冬")
'("加" "减" "乘" "除")
'("喜" "怒" "哀" "乐")
'("爱" "恨" "情" "愁")
'("江" "河" "湖" "海")
'("琴" "棋" "书" "画")
'("大" "小" "多" "少")
'("天" "地" "人")
'("日" "月" "年")
'("时" "分" "秒")
'("黑" "白" "灰")
'("平" "立" "剖")
'("正" "背" "侧")
'("-" ".")
'("：" ":")
'("，" ",")
'("（" "(" "[")
'("）" ")" "]")
'("主" "次")
'("给" "排")
'("梁" "板")
'("水" "电")
'("雨" "污")
'("男" "女")
'("开" "关")
'("进" "出")
'("新" "旧")
'("美" "丑")
'("好" "坏")
'("动" "静")
'("冷" "热")
'("强" "弱")
'("明" "暗")
'("善" "恶")
'("真" "假")
'("高" "矮")
'("胖" "瘦")
'("长" "短")
'("宽" "窄")
'("快" "慢")
'("远" "近")
'("软" "硬")
'("轻" "重")
'("清" "浊")
'("昼" "夜")
'("香" "臭")
'("深" "浅")
'("胜" "败")
'("干" "湿")
'("顺" "逆")
'("推" "拉")
'("伸" "缩")
'("升" "降")
'("单" "双")
'("奇" "偶")
'("阴" "阳")
'("顶" "底")
'("粗" "细")
)
)

;单字符列表:相同的字符不能重复出现,否则容易匹配错误 
(setq OneSTRLst 
  (list 
    '("零" "壹" "贰" "叁" "肆" "伍" "陆" "柒" "捌" "玖" "拾" "佰" "仟" "萬" "億") 
    '("一" "二" "三" "四" "五" "六" "七" "八" "九" "十") 
    '("甲" "乙" "丙" "丁" "戊" "己" "庚" "辛" "壬" "癸") 
    '("㈠" "㈡" "㈢" "㈣" "㈤" "㈥" "㈦" "㈧" "㈨" "㈩") ;括号汉字 
    '("⑴" "⑵" "⑶" "⑷" "⑸" "⑹" "⑺" "⑻" "⑼" "⑽") ;括号数字 
    '("①" "②" "③" "④" "⑤" "⑥" "⑦" "⑧" "⑨" "⑩") ;圆圈数字 
    '("Ⅰ" "Ⅱ" "Ⅲ" "Ⅳ" "Ⅴ" "Ⅵ" "Ⅶ" "Ⅷ" "Ⅸ" "Ⅹ" "Ⅺ" "Ⅻ") ;罗马数字1-12大写 
    '("ⅰ" "ⅱ" "ⅲ" "ⅳ" "ⅴ" "ⅵ" "ⅶ" "ⅷ" "ⅸ" "ⅹ") ;罗马数字1-10小写 
    '("%%130" "%%131" "%%132" "%%133") ;钢筋符号 
    '("红" "橙" "黄" "绿" "青" "蓝" "紫") 
    '("前" "后" "左" "右" "上" "下") 
    '("东" "西" "南" "北" "中") 
    '("酸" "甜" "苦" "辣" "咸") 
 
    '("春" "夏" "秋" "冬") 
    '("加" "减" "乘" "除") 
    '("喜" "怒" "哀" "乐") 
    '("爱" "恨" "情" "愁") 
    '("江" "河" "湖" "海") 
    '("琴" "棋" "书" "画") 
    '("大" "小" "多" "少") 
 
    '("天" "地" "人") 
    '("日" "月" "年") 
    '("时" "分" "秒") 
    '("黑" "白" "灰") 
    '("平" "立" "剖") 
    '("正" "背" "侧") 
 
    '("-" ".") 
    '("：" ":") 
    '("，" ",") 
    '("（" "(" "[") 
    '("）" ")" "]") 
    '("主" "次") 
    '("给" "排") 
    '("梁" "板") 
    '("水" "电") 
    '("雨" "污") 
    '("男" "女") 
    '("开" "关") 
    '("进" "出") 
    '("新" "旧") 
    '("美" "丑") 
    '("好" "坏") 
    '("动" "静") 
    '("冷" "热") 
    '("强" "弱") 
    '("明" "暗") 
    '("善" "恶") 
    '("真" "假") 
    '("高" "矮") 
    '("胖" "瘦") 
    '("长" "短") 
    '("宽" "窄") 
    '("快" "慢") 
    '("远" "近") 
    '("软" "硬") 
    '("轻" "重") 
    '("清" "浊") 
    '("昼" "夜") 
    '("香" "臭") 
    '("深" "浅") 
    '("胜" "败") 
    '("干" "湿") 
    '("顺" "逆") 
    '("推" "拉") 
    '("伸" "缩") 
    '("升" "降") 
    '("单" "双") 
    '("奇" "偶") 
    '("阴" "阳") 
    '("顶" "底") 
    '("粗" "细") 
  ) 
)

;多字符列表:字符串包含在另一个串字符中时,较长的写在前面
(setq MoreSTRLst
(list
'("亚光面" "光面" "烧面" "烧洗面" "荔枝面" "自然面")
'("详图" "平面图" "立面图" "剖面图" "大样图" "意向图")
'("园建" "给排水" "电气" "水电" "结构")
'("索引及物料" "索引" "物料" "尺寸及竖向" "尺寸定位" "竖向设计" "坐标定位" "网格放样")
'("尺寸" "尺寸定位")
'("竖向" "竖向设计")
'("置石分布" "小品设施分布" "超荷载换填")
'("置石" "置石分布")
'("小品" "小品设施分布")
'("镀锌" "热镀锌" "不锈钢")
'("方通" "圆通" "扁通")
'("竹木" "塑木" "防腐木")
)
)

kucha007 · 发表于 2023-6-2 16:09

qazxswk 发表于 2023-6-2 15:31
阅读权限设置太高，这就如视频网站看视频前的广告，没钱人因为没有钱充会员，看了广告却买不起广告里的商品 ...

那我不管。反正有fas可以用，想下源码就混论坛。
会不会写关我屁事，我只是不想自己花时间完善的程序被不懂的人乱改，然后疯狂问我为什么改了不行？
有这个权限的人哪怕不知道怎么改，也应该知道问没意义的问题不如多反馈bug一起完善程序。或者直接贴代码出来一起学习

kucha007 · 发表于 2023-5-30 08:30

e719 发表于 2023-5-30 08:24
阅读权限: 50
......

非要下源码？
我定的权限和我现在的一样，这样能下源码的基本上就能看懂怎么回事，知道怎么改。
不会改的，直接用fas的就好

小毛草 · 发表于 2023-9-23 09:23

本帖最后由小毛草于 2023-9-23 09:53 编辑

kucha007 发表于 2023-9-22 20:36
修复了，再试试看

确实已经修复，谢谢！兄弟，能让以下代码支持属性块吗？

;_仿sketchup动态复制程序
(defun c:ddc (/ #error $orr p1 p2 s e cn a1 d1 ns cnn)
;___
(defun #error (s)
(command ".UNDO" "E")
(setvar "osmode" snap)
(setq *error* $orr)
)
(setq snap (getvar "osmode"))
(setvar "cmdecho" 0)
(setq $orr *error*
*error* #errormike
)_______________
(defun ttt (ss n / m)
(setq ee e
ns (ssadd)
)
(while (setq ee (entnext ee))
(setq ns (ssadd ee ns))
)
(command "erase" ns "")
(command "copy" ss "" "m" "non" p1)
(if (member (substr n (strlen n)) '("/" "*"))
(progn
(setq m 0)
(repeat (atoi n)
(setq m (1+ m))
(cond
((= "/" (substr n (strlen n)))
(command "non"(mapcar '(lambda (x y) (+ x (* m (/ (- y x) (atof n))))) p1 p2))
)
((= "*" (substr n (strlen n)))
(command "non"(mapcar '(lambda (x y) (+ x (* m (- y x)))) p1 p2))
)
)
)
)
(command "non" (setq p2 (polar p1 a1 (atof n))))
)
(command)
)
;__________________
(princ "\n动态复制程序")
(princ "\n选择要复制的物体:")
(setq s (ssget))
(setq p1 (getpoint "\n复制的起点:"))
(command "undo" "be" "line" p1 p1 "" )
(setq e (entlast) )
(command "copy" s "" "non" p1 pause)
(setq p2 (getvar "lastpoint")
a1 (angle p1 p2)
d1 (distance p1 p2)
)
(setq cn "1*")
(while cn
(ttt s cn)
(initget 128)
(princ "\n输入坐标=复制终点输入数值=修改间距 ")
(princ "\n输入数值n并以 / 结束=间距内等分n次复制输入数值n并以 * 结束=按间距复制n次 ")
(setq cnn (getpoint "\n请按提示输入<退出>:"))
(if (= 'LIST (type cnn))
(setq p2 cnn
a1 (angle p1 p2)
d1 (distance p1 p2)
)
(setq cn cnn)
)
)
(entdel e)
(command "undo" "e")
(princ)
)
________________________________________________
;_仿sketchup动态旋转程序
(defun c:ddr(/ p1 p2 p3 a1 cn cnn tmp e s)
;_____________________________
(defun rc (os / ns ne)
(setq ne (entlast)
ns (ssadd)
)
(command "copy" os "" "0,0" "0,0")
(while (setq ne (entnext ne))
(setq ns (ssadd ne ns))
)
ns
)
(defun ttt (ss n / m ee ns sn )
(setq ee e
ns (ssadd)
)
(while (setq ee (entnext ee))
(setq ns (ssadd ee ns))
)
(command "erase" ns "")
(if (member (substr n (strlen n)) '("/" "*"))
(progn
(setq m 0)
(repeat (atoi n)
(setq m (1+ m))
(setq sn(rc ss))
(cond
((= "/" (substr n (strlen n)))
(command "rotate" sn "" p1 (* m (/ a1 (atof n))))
)
((= "*" (substr n (strlen n)))
(command "rotate" sn "" p1 (* m a1))
)
)
)
)
(progn
(setq sn(rc ss))
(command "rotate" sn "" p1 (setq a1 (atof n)))
)
)
)
;_____________________________
(princ "\n动态旋转程序")
(princ "\n选择要旋转的物体:")
(setq s (ssget))
(setq p1 (getpoint "\n旋转基点"))
(setq p2 (getpoint p1 "\n旋转起点"))
(command "undo" "be" "line" p1 p2 "")
(setq e (entlast))
(setq p3 (getpoint p1 "\n旋转终点"))
(setq tmp (rc s) )
(command "rotate" tmp "" p1 "r" p1 p2 p3)
(setq cn "1*" a1 (* 180 (/ (-(angle p1 p3)(angle p1 p2))pi)))
(while cn
(ttt s cn)
(initget 128)
(princ "\n输入坐标=旋转终点输入数值=旋转角度 ")
(princ "\n输入数值n并以 / 结束=角度内等分n次复制输入数值n并以 * 结束=按角度复制n次 ")
(setq cnn (getpoint "\n请按提示输入<退出>:"))
(if (= 'LIST (type cnn))
(setq p3 cnn
a1 (* 180 (/ (-(angle p1 p3)(angle p1 p2))pi))
)
(setq cn cnn)
)
)
(entdel e)
(command "undo" "e")
(princ)
)

;_仿sketchup动态复制程序 
(defun   c:ddc (/ #error $orr p1 p2 s e cn a1 d1 ns cnn) 
 ;___ 
 (defun #error (s) 
    (command ".UNDO" "E") 
    (setvar "osmode" snap) 
    (setq *error* $orr) 
  ) 
  (setq snap (getvar "osmode")) 
  (setvar "cmdecho" 0) 
  (setq $orr *error* 
        *error* #errormike 
  )_______________ 
  (defun ttt (ss n / m) 
    (setq ee e 
      ns (ssadd) 
    ) 
    (while (setq ee (entnext ee)) 
      (setq ns (ssadd ee ns)) 
    ) 
    (command "erase" ns "") 
    (command "copy" ss "" "m" "non" p1) 
    (if (member (substr n (strlen n)) '("/" "*"))       
      (progn 
  (setq m 0) 
  (repeat  (atoi n) 
    (setq m (1+ m)) 
    (cond 
      ((= "/" (substr n (strlen n))) 
       (command "non"(mapcar '(lambda (x y) (+ x (* m (/ (- y x) (atof n))))) p1 p2)) 
      ) 
      ((= "*" (substr n (strlen n))) 
       (command "non"(mapcar '(lambda (x y) (+ x (* m (- y x)))) p1 p2)) 
      ) 
    ) 
  ) 
      ) 
      (command "non" (setq p2 (polar p1 a1 (atof n)))) 
    ) 
    (command) 
  ) 
 ;__________________ 
  (princ "\n动态复制程序") 
  (princ "\n选择要复制的物体:") 
  (setq s (ssget)) 
  (setq p1 (getpoint "\n复制的起点:")) 
  (command "undo" "be" "line" p1 p1 "" ) 
  (setq e (entlast) ) 
  (command "copy" s "" "non" p1 pause) 
  (setq  p2 (getvar "lastpoint") 
  a1 (angle p1 p2) 
  d1 (distance p1 p2) 
  ) 
  (setq cn "1*") 
  (while cn 
    (ttt s cn) 
    (initget 128) 
    (princ "\n输入坐标=复制终点                         输入数值=修改间距 ") 
    (princ "\n输入数值n并以 / 结束=间距内等分n次复制    输入数值n并以 * 结束=按间距复制n次 ") 
    (setq cnn (getpoint "\n请按提示输入<退出>:")) 
    (if  (= 'LIST (type cnn)) 
      (setq p2 cnn 
      a1 (angle p1 p2) 
      d1 (distance p1 p2) 
      ) 
      (setq cn cnn) 
    ) 
  ) 
  (entdel e) 
  (command "undo" "e") 
  (princ) 
) 
 
________________________________________________ 
;_仿sketchup动态旋转程序 
(defun c:ddr(/ p1 p2 p3 a1 cn cnn tmp e s) 
  ;_____________________________ 
  (defun rc (os / ns ne) 
    (setq ne (entlast) 
    ns (ssadd) 
    ) 
    (command "copy" os ""  "0,0"   "0,0") 
    (while (setq ne (entnext ne)) 
      (setq ns (ssadd ne ns)) 
    ) 
    ns 
  ) 
  (defun ttt (ss n / m ee ns sn ) 
    (setq ee e 
      ns (ssadd) 
    ) 
    (while (setq ee (entnext ee)) 
      (setq ns (ssadd ee ns)) 
    ) 
    (command "erase" ns "")    
    (if (member (substr n (strlen n)) '("/" "*"))       
      (progn 
  (setq m 0) 
  (repeat  (atoi n) 
    (setq m (1+ m)) 
    (setq sn(rc ss)) 
    (cond 
      ((= "/" (substr n (strlen n))) 
       (command  "rotate" sn "" p1 (* m (/ a1 (atof n)))) 
      ) 
      ((= "*" (substr n (strlen n))) 
       (command  "rotate" sn "" p1 (* m a1)) 
      ) 
    ) 
  ) 
      ) 
      (progn 
  (setq sn(rc ss)) 
      (command  "rotate" sn "" p1 (setq a1 (atof n))) 
      ) 
    ) 
  ) 
  ;_____________________________ 
  (princ "\n动态旋转程序") 
  (princ "\n选择要旋转的物体:")   
  (setq s (ssget)) 
  (setq p1 (getpoint "\n旋转基点")) 
  (setq p2 (getpoint p1 "\n旋转起点")) 
  (command "undo" "be" "line"  p1  p2 "") 
  (setq e (entlast)) 
  (setq p3 (getpoint p1 "\n旋转终点")) 
  (setq tmp (rc s) ) 
  (command  "rotate" tmp ""  p1 "r"  p1  p2  p3) 
  (setq cn "1*" a1 (* 180 (/ (-(angle p1 p3)(angle p1 p2))pi)))   
  (while cn    
    (ttt s cn) 
    (initget 128) 
    (princ "\n输入坐标=旋转终点                         输入数值=旋转角度 ") 
    (princ "\n输入数值n并以 / 结束=角度内等分n次复制    输入数值n并以 * 结束=按角度复制n次 ") 
    (setq cnn (getpoint "\n请按提示输入<退出>:")) 
    (if  (= 'LIST (type cnn)) 
      (setq p3 cnn 
      a1 (* 180 (/ (-(angle p1 p3)(angle p1 p2))pi)) 
      ) 
      (setq cn cnn) 
    ) 
  ) 
  (entdel e) 
  (command "undo" "e") 
  (princ) 
)

e719 · 发表于 2023-5-30 08:24

阅读权限: 50
......

e719 · 发表于 2023-5-30 08:38

虽然不会大改，但源码可以按照自己的需求小改。

e719 · 发表于 2023-5-30 08:40

最最最常改的是快捷键，每个人的使用习惯不同，就会按自己的习惯来改2

kucha007 · 发表于 2023-5-30 08:41

e719 发表于 2023-5-30 08:40
最最最常改的是快捷键，每个人的使用习惯不同，就会按自己的习惯来改2

那就下链接里的源程序

e719 · 发表于 2023-5-30 08:42

kucha007 发表于 2023-5-30 08:41
那就下链接里的源程序

嗯嗯，还差点权限
抱歉，只有特定用户可以下载本站附件

kucha007 · 发表于 2023-5-30 08:46

e719 发表于 2023-5-30 08:42
嗯嗯，还差点权限
抱歉，只有特定用户可以下载本站附件

降到40了，你可以下

e719 · 发表于 2023-5-30 08:54

好的，谢谢

aggdqty · 发表于 2023-5-30 09:06

谢谢分享，可以改快捷键了

账号		自动登录	找回密码
密码			注册

【DZ】文字增减_v1.9——支持词组匹配+钢筋符号+罗马数字

本帖子中包含更多资源

评分

评分