设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › 源码共享 › 改写本坛大侠一个很有价值的代码
12下一页
返回列表 发新帖
查看: 2608|回复: 10

改写本坛大侠一个很有价值的代码

  [复制链接]
尘缘一生
发表于 2021-11-1 19:32:40 | 显示全部楼层 |阅读模式
本帖最后由 尘缘一生 于 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
  • )



评分

参与人数 3明经币 +3 收起 理由
USER2128 + 1 赞一个!
bssurvey + 1 赞一个!
669423907 + 1 很给力!

查看全部评分

回复

使用道具 举报

669423907
发表于 2021-11-1 22:12:03 | 显示全部楼层
楼主好有激情，谢谢楼主分享好程序。
方便帮修复一下下面的帖子的程序吗
http://bbs.mjtd.com/thread-183522-1-1.html
回复 支持 反对

使用道具 举报

尘缘一生
 楼主| 发表于 2021-11-2 08:38:09 | 显示全部楼层
本帖最后由 尘缘一生 于 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 "*[a-zA-Z]")
  •     (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修改等其他
  •   )
  • )



回复 支持 反对

使用道具 举报

飒路紫
发表于 2021-11-4 10:41:49 | 显示全部楼层
请问与原贴比，修订或改进了哪些功能?
回复 支持 反对

使用道具 举报

依然小小鸟
发表于 2021-11-6 13:04:52 | 显示全部楼层
希望增加对罗马数字的支持
回复 支持 反对

使用道具 举报

尘缘一生
 楼主| 发表于 2021-11-6 23:26:43 | 显示全部楼层
再版：
罗马字符支持其实很简单，加上即可，这个问题，到此可以了。
但是，还是不支持块、标注，需要打散炸开。


  • ;;汉字序号、钢筋、字符-->左加右减------【开始】--------
  • ;;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)
  • )
  • ;;汉字序号、钢筋、字符-->左加右减------【结束】-----------


回复 支持 反对

使用道具 举报

DoubleV
发表于 2021-11-7 18:25:22 | 显示全部楼层
错误: no function definition: SYSVAR
请问这个啥错误？原贴也没有这个参数。
回复 支持 反对

使用道具 举报

LYC688
发表于 2021-12-20 06:36:51 | 显示全部楼层
大佬，比如异形状，方形等，写一个程序批量清角，让位的LSP程序呗
回复 支持 反对

使用道具 举报

liufii
发表于 2022-3-14 20:40:27 | 显示全部楼层
错误: no function definition: SYSVAR
原帖中没找到这个函数，请问楼主，哪里可以找到啊。
回复 支持 反对

使用道具 举报

12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-11-25 08:40 , Processed in 0.506479 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表