明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
楼主: szx025

[源码] 文字加减复制的lisp程序

[复制链接]
 楼主| 发表于 2018-6-14 08:37 | 显示全部楼层
lostbalance 发表于 2018-6-13 19:41
你把程序再发一遍看看
  1. (defun C:T11 ( / buchang1 $buchang SS SS1 e0 ent PT i loop ENTL E-1 NEWTX ENT_TMP)
  2. (setvar "dimzin" 0)
  3.   (if (null $buchang) (setq $buchang 1))
  4.   (setq $buchang (ureal 1 "" "\n增减值(正为增,负为减)" $buchang) buchang1 $buchang)
  5.   (setq ss (ssget '((0 . "*TEXT"))))
  6. (setq e0 (entlast))  
  7.   (setq pt (getpoint "指定基点:"))   
  8.   (command "copy" ss "" pt pause)  
  9.   (setq loop T)
  10.   (while loop   
  11.   (SETQ SS1 (last_ent E0) I 0)
  12.   (repeat (sslength ss1)
  13.     (setq ent (ssname ss1 i)
  14.           entl (entget ent);图元资料
  15.           e-1 (cdr (assoc 1 entl));;文字内容
  16.           i (1+ i)
  17.           (setq NEWTX (rtos (+ (atof E-1) BUCHANG1)) 2 3)
  18.     )
  19.    (entmod (subst (cons 1 NEWTX) (assoc 1 entl) entl));更新文字
  20.   );end repeat  
  21. (setq e0 (entlast))
  22. (setq buchang1 (+ buchang1 $buchang))
  23.     (command "copy" ss "" pt pause)
  24.     (setq Point (getvar "LastPoint"))
  25.     (if (= 0 (distance Point pt)) ;判断最后一点是不是pt点.
  26.         (progn
  27.         (setq loop nil) ;Right Button
  28.         (setq ent_tmp (LAST_ENT e0)) ;ent_tmp 是e0后生成的物体.
  29.         (command "_.erase" ent_tmp "" )
  30.         )      
  31.         )   
  32.   );end while
  33. )   
  34. (defun last_ent (en / ss)
  35.    (if en
  36.      (progn
  37.        (setq ss (ssadd))
  38.        (while (setq en (entnext en))
  39.          (if (not (member (cdr (assoc 0 (entget en)))
  40.                           '("ATTRIB" "VERTEX" "SEQEND")
  41.                   )
  42.              )
  43.            (ssadd en ss)
  44.          );if
  45.        );while
  46.        (if (zerop (sslength ss)) (setq ss nil))
  47.        ss
  48.      );progn
  49.      (ssget "_x")
  50.    );if
  51. )
  52. (defun Plus1 (str buchang / d1 d2 h)
  53.   (setq str (vl-string-translate "-" (chr 1) str))
  54.   (setq d1 (last (string_to_numbers str))
  55.         h (vl-string-right-trim d1 str))
  56.   (setq d2 (vl-princ-to-string (+ (read d1) buchang)))
  57.   (while (< (strlen d2) (strlen d1))
  58.   (setq d2 (strcat  d2 "0" ))
  59.    ; (setq d2 (strcat "0" d2))
  60.   )
  61.   (vl-string-translate (chr 1) "-" (strcat h d2))
  62. )

  63. ;;; Bill Kramer
  64. ;
  65. (defun String_To_Numbers (
  66.                           inStr  ;;Input string
  67.                           /
  68.                           Res    ;;Result list
  69.                           Buf    ;;String buffer
  70.                           Inx      ;;Character location
  71.                           CH     ;;Character
  72.                           )
  73.   (setq Inx 1 ;start at the beginning of the string
  74.         Buf "" ;init buffer to empty
  75.         )
  76.   ;
  77.   ; Loop until the end of the string.
  78.   ; (I indicates where we are in the string)
  79.   ;
  80.   (while (<= Inx (strlen inStr))
  81.     ;
  82.     ; Get the character at position Inx, increment position indicator
  83.     (setq CH (substr inStr Inx 1)
  84.           Inx (1+ Inx)
  85.           )
  86.     ;
  87.     (cond
  88.       ; Test to see if character is a digit.
  89.       ((wcmatch CH "[0-9.]")
  90.         (if (= CH ".") ;is it decimal?
  91.           (if (not (wcmatch Buf "*`.*")) ;not already in there
  92.             (setq Buf (strcat Buf CH))
  93.             (Flush_Buf))
  94.           ;
  95.           (setq Buf (strcat Buf CH)))
  96.       )
  97.       ((= Buf "") ;is the buffer empty?
  98.                ;Is CH minus
  99.         (if (= CH "-")
  100.           (setq Buf CH) ;Yes, save in Buf
  101.         )
  102.       )
  103.       ('T ;else buffer is not empty
  104.         (Flush_Buf)
  105.         (if (= CH "-")
  106.           (setq Buf CH))
  107.       )
  108.     ); End of COND
  109.   ); End of WHILE
  110.   ;
  111.   (if (and (/= Buf "")
  112.            (not (wcmatch Buf "[+-.]"))
  113.            )
  114.     (Flush_Buf))
  115.   (reverse Res)
  116. )
  117. (defun Flush_Buf ()
  118.   (if (not (wcmatch Buf "[+-.]")) ;is it not just +-.?
  119.     (progn
  120.       ;Clean it up first
  121.       (if (= (substr Buf 1 1) ".")
  122.         (setq Buf (strcat "0" Buf))) ;;add zero to front if .#
  123.       (if (= (substr Buf (strlen Buf)) ".")
  124.         (setq Buf (substr Buf 1 (1- (strlen Buf))))) ;;remove decimal if #.
  125.       ;Add to RES list
  126.       (setq RES (cons Buf RES))))
  127.   (setq Buf "") ;;reset Buf
  128. )
 楼主| 发表于 2018-6-15 15:09 | 显示全部楼层
呼叫 lostbalance
发表于 2018-6-16 23:43 | 显示全部楼层

好像网络问题,前两天发的没成功啊……
手机上的,简单说下吧……
1. rtos那行,2 3两个值是rtos的参数,所以位置错了,要移到里面一个括号里。
2. 还是那行,前面的setq没结束,又setq了,格式不对。
3. dimzin设为0,个人感觉对于正常的绘图来说不合适,所以最好还是做恢复处理。
建议如下:
最开始的dimzin设置删掉,然后把setq newtx那行删掉,在下面的entmod前面把我上面的那4行代码复制过来,然后改一下2 3的位置,应该就可以了。
发表于 2018-6-16 23:44 来自手机 | 显示全部楼层
因为有dimzin的相关操作,新家的代码就不要和原来的setq放一起了。
发表于 2018-6-16 23:48 来自手机 | 显示全部楼层
另外,你这函数没有错误恢复处理,dimzin值在出错的时候可能会无法恢复,所以调整和恢复之间的其他代码越少越好,虽然效率低了点,但处理量不大的情况下,也没什么感觉。
 楼主| 发表于 2018-6-17 09:05 | 显示全部楼层
谢谢 问题解决了,非常谢谢
 楼主| 发表于 2018-6-19 09:35 | 显示全部楼层
lostbalance 发表于 2018-6-16 23:43
好像网络问题,前两天发的没成功啊……
手机上的,简单说下吧……
1. rtos那行,2 3两个值是rtos的参数 ...

这样改对纯数字没有问题,但带字母数字,比如"TB-1"这样的数字,运行后前面的字母就没有了,要想保留原程序的功能这个(defun Plus1 (str buchang / d1 d2 h)还是要保留,在这个基础上,怎么完善,还请指导
发表于 2018-6-19 10:49 | 显示全部楼层
szx025 发表于 2018-6-19 09:35
这样改对纯数字没有问题,但带字母数字,比如"TB-1"这样的数字,运行后前面的字母就没有了,要想保留原程 ...

。。。。。。要求要说清楚啊。。。。
如果只是后面补零,在plus1里,对d2参照newtx进行修改
(setq d2 (vl-princ-to-string (+ (read d1) buchang)))
  (while (< (strlen d2) (strlen d1))
  (setq d2 (strcat  d2 "0" ))
   ; (setq d2 (strcat "0" d2))
  )
上面的删掉,改成
(setq odimzin (getvar "dimzin")) ;;取得原来dimzin
(setvar "dimzin" 0) ;;设置dimzin为0
(setq d2 (rtos (+ (read d1) buchang) 2 3))
(setvar "dimzin" odimzin) ;;恢复dimzin
如果前面要补零,那把原来的那个while加到后面
 楼主| 发表于 2018-6-19 13:54 | 显示全部楼层
lostbalance 发表于 2018-6-19 10:49
。。。。。。要求要说清楚啊。。。。
如果只是后面补零,在plus1里,对d2参照newtx进行修改
(setq d2 ( ...

这里还有一个问题,按你这样改所有数字都是保留小数点3位。但我的要求是,如果原来的数是整数,没有小数点,程序运行后还是整数,如果原是小数,程序运行后保留小数点3位。
发表于 2018-6-20 09:02 | 显示全部楼层
szx025 发表于 2018-6-19 13:54
这里还有一个问题,按你这样改所有数字都是保留小数点3位。但我的要求是,如果原来的数是整数,没有小数 ...

加一个判断啊
(setq d2 (+ (read d1) buchang))
(if (= d2 (fix d2)) ;;判断d2是不是整数
    (setq d2 (itoa d2)) ;;转字符串
    (progn
        (setq odimzin (getvar "dimzin")) ;;取得原来dimzin
        (setvar "dimzin" 0) ;;设置dimzin为0
        (setq d2 (rtos d2 2 3)) ;;转字符串
        (setvar "dimzin" odimzin) ;;恢复dimzin
    )
)
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 15:21 , Processed in 0.285119 second(s), 18 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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