明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 446|回复: 21

[已解答] 动态数字增加

  [复制链接]
发表于 2022-5-10 21:33 | 显示全部楼层 |阅读模式
本帖最后由 表骑马实开车 于 2022-5-11 15:48 编辑
  1. (defun c:tt (/ stmerr numb e edt e1 edt1 cnd grd typ cdt pl)
  2.   (princ "\n按ESC或空格或回车完成计数.")
  3.   (setvar "cmdecho" 0)
  4.   (setq stmerr *error*)
  5.   (setq *error* myerror)
  6.   (setq numb 1)
  7.   (addnb numb '(0 0) '(0 0))
  8.   (setq  e   (entlast)
  9.   edt (entget e)
  10.   pl  (getmid edt)
  11.   )
  12.   (addarc '(0 0) (cadr pl))
  13.   (setq  e1   (entlast)
  14.   edt1 (entget e1)
  15.   )
  16.   (setq cnd T)
  17.   (while cnd
  18.     (setq grd (grread T 8))
  19.     (setq typ (car grd)
  20.     cdt (cadr grd)
  21.     )
  22.     (cond
  23.       ;; 鼠标左键
  24.       ((= typ 3)
  25.        (setq numb (1+ numb))
  26.        (addnb numb
  27.         (polar cdt 2.35 (+ (cadr pl) 80))
  28.         (polar cdt 2.35 (+ (cadr pl) 80))
  29.        )
  30.        (setq
  31.    e   (entlast)
  32.    edt (entget e)
  33.    pl  (getmid edt)
  34.        )
  35.        (addarc (polar cdt 2.35 (cadr pl)) (cadr pl))
  36.        (setq
  37.    e1   (entlast)
  38.    edt1 (entget e1)
  39.        )
  40.       )
  41.       ;;11鼠标左键点击菜单栏,25鼠标右键
  42.       ((or (= typ 11) (= typ 25))
  43.        (setq cnd  nil
  44.        numb (1- numb)
  45.        )
  46.        (entdel e)
  47.        (entdel e1)
  48.       )

  49.       ;; 空格、回车键
  50.       ((or (equal grd '(2 32)) (equal grd '(2 13)))
  51.        (setq cnd  nil
  52.        numb (1- numb)
  53.        )
  54.        (entdel e)
  55.        (entdel e1)
  56.       )
  57.       ;; 鼠标移动
  58.       ((= typ 5)
  59.        (setq
  60.    edt  (subst (cons 10 (polar cdt 2.35 (+ (cadr pl) 80)))
  61.          (assoc 10 edt)
  62.          edt
  63.         )
  64.    edt  (subst (cons 11 (polar cdt 2.35 (+ (cadr pl) 80)))
  65.          (assoc 11 edt)
  66.          edt
  67.         )
  68.    edt  (subst (cons 1 (strcat (rtos numb 2 0)))
  69.          (assoc 1 edt)
  70.          edt
  71.         )
  72.    edt1 (subst (cons 10 (polar cdt 2.35 (+ (cadr pl) 80)))
  73.          (assoc 10 edt1)
  74.          edt1
  75.         )
  76.        )
  77.        (entmod edt)
  78.        (entmod edt1)
  79.       )
  80.     )
  81.   )
  82.   (princ (strcat "\n本次计数:" (rtos numb 2 0)))

  83.   (setq *error* stmerr)
  84.   (princ)
  85. )

  86. ;;加文字
  87. (defun addnb (n p1 p2)
  88.   (entmake (list '(0 . "TEXT")
  89.      (cons 1 (strcat (rtos n 2 0)))
  90.      (cons 10 p1)
  91.      (cons 11 p2)
  92.      (cons 40 160)
  93.      (cons 62 2)
  94.      (cons 71 0)
  95.      (cons 72 1)
  96.      (cons 73 2)
  97.      )
  98.   )
  99. )


  100. ;;画圆
  101. (defun addarc (m r)
  102.   (entmakex
  103.     (list '(0 . "CIRCLE") '(62 . 2) (cons 10 m) (cons 40 r))
  104.   )
  105. )

  106. ;;文字包围框
  107. ;;By lee mac
  108. (defun LM:textbox (enx / bpt hgt jus lst ocs org rot wid)
  109.   (cond
  110.     ((and (= "ATTRIB" (cdr (assoc 000 enx)))
  111.     (= "Embedded Object" (cdr (assoc 101 enx)))
  112.      )
  113.      (LM:textbox
  114.        (cons '(000 . "MTEXT")
  115.        (member '(101 . "Embedded Object") enx)
  116.        )
  117.      )
  118.     )
  119.     ((cond
  120.        ((wcmatch (cdr (assoc 000 enx)) "ATTRIB,TEXT")
  121.   (setq bpt (cdr (assoc 010 enx))
  122.         rot (cdr (assoc 050 enx))
  123.         lst (textbox enx)
  124.         lst (list  (car lst)
  125.       (list (caadr lst) (cadar lst))
  126.       (cadr lst)
  127.       (list (caar lst) (cadadr lst))
  128.       )
  129.   )
  130.        )
  131.        ((= "MTEXT" (cdr (assoc 000 enx)))
  132.   (setq ocs (cdr (assoc 210 enx))
  133.         bpt (trans (cdr (assoc 010 enx)) 0 ocs)
  134.         rot (angle '(0.0 0.0) (trans (cdr (assoc 011 enx)) 0 ocs))
  135.         wid (cdr (assoc 042 enx))
  136.         hgt (cdr (assoc 043 enx))
  137.         jus (cdr (assoc 071 enx))
  138.         org (list  (cond ((member jus '(2 5 8)) (/ wid -2.0))
  139.             ((member jus '(3 6 9)) (- wid))
  140.             (0.0)
  141.       )
  142.       (cond ((member jus '(1 2 3)) (- hgt))
  143.             ((member jus '(4 5 6)) (/ hgt -2.0))
  144.             (0.0)
  145.       )
  146.       )
  147.         lst (list  org
  148.       (mapcar '+ org (list wid 0))
  149.       (mapcar '+ org (list wid hgt))
  150.       (mapcar '+ org (list 0 hgt))
  151.       )
  152.   )
  153.        )
  154.      )
  155.      ((lambda (m)
  156.   (mapcar '(lambda (p) (mapcar '+ (mxv m p) bpt)) lst)
  157.       )
  158.        (list
  159.    (list (cos rot) (sin (- rot)) 0.0)
  160.    (list (sin rot) (cos rot) 0.0)
  161.    '(0.0 0.0 1.0)
  162.        )
  163.      )
  164.     )
  165.   )
  166. )



  167. ;; 矩阵 x 向量
  168. ;;By lee mac
  169. (defun mxv (m v)
  170.   (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
  171. )

  172. ;;文字中心点/半径
  173. (defun getmid (e / p m r)
  174.   (setq  p (LM:textbox e)
  175.   m (inters (car p) (caddr p) (cadr p) (cadddr p))
  176.   r (+ (distance m (car p)) 6)
  177.   )
  178.   (list m r)
  179. )


  180. ;;按esc键 结束程序
  181. (defun myerror (msg)
  182.   (if (wcmatch msg "*取消*")
  183.     (progn
  184.       (setq numb (1- numb))
  185.       (entdel e)
  186.       (entdel e1)
  187.     )
  188.   )
  189.   (princ (strcat "\n本次计数:" (rtos numb 2 0)))
  190.   (setq *error* stmerr)
  191. )


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 2明经币 +2 收起 理由
USER2128 + 1 赞一个!
bssurvey + 1 赞一个!

查看全部评分

发表于 2022-5-12 14:24 | 显示全部楼层



本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
回复 支持 1 反对 0

使用道具 举报

 楼主| 发表于 2022-5-11 16:52 | 显示全部楼层
本帖最后由 表骑马实开车 于 2022-5-11 17:09 编辑
  1. (defun c:tt (/ stmerr numb e edt cnd grd typ cdt)
  2.   (princ "\n按ESC或空格或回车完成计数.")
  3.   (setvar "cmdecho" 0)
  4.   (setq stmerr *error*)
  5.   (setq *error* myerror)
  6.   (or numb (setq numb 1))
  7.   (setq  numb
  8.    (cond
  9.      ((getreal (strcat "\n输入起始编号: 默认<"
  10.            (rtos numb 2 2)
  11.            ">: "
  12.          )
  13.       )
  14.      )
  15.      (numb)
  16.    )
  17.   )
  18.   (addnb numb '(0 0) '(0 0))
  19.   (setq  e   (entlast)
  20.   edt (entget e)
  21.   )
  22.   (setq cnd T)
  23.   (while cnd
  24.     (setq grd (grread T 8))
  25.     (setq typ (car grd)
  26.     cdt (cadr grd)
  27.     )
  28.     ;; 鼠标左键
  29.     (cond
  30.       ((= typ 3)
  31.        (setq numb (1+ numb))
  32.        (addnb numb cdt cdt)
  33.        (setq
  34.    e   (entlast)
  35.    edt (entget e)
  36.        )
  37.       )
  38.       ;;11鼠标左键点击菜单栏,25鼠标右键
  39.       ((or (= typ 11) (= typ 25))
  40.        (setq cnd  nil
  41.        numb (1- numb)
  42.        )
  43.        (entdel e)
  44.       )

  45.       ;; 空格、回车键
  46.       ((or (equal grd '(2 32)) (equal grd '(2 13)))
  47.        (setq cnd  nil
  48.        numb (1- numb)
  49.        )
  50.        (entdel e)
  51.       )
  52.       ;; 鼠标移动
  53.       ((= typ 5)
  54.        (setq
  55.    edt (subst (cons 10 cdt) (assoc 10 edt) edt)
  56.    edt (subst (cons 11 cdt) (assoc 11 edt) edt)
  57.    edt (subst (cons 1 (strcat (rtos numb 2 0)))
  58.         (assoc 1 edt)
  59.         edt
  60.        )
  61.        )
  62.        (entmod edt)
  63.       )
  64.     )
  65.   )
  66.   (princ (strcat "\n本次计数:" (rtos numb 2 0)))
  67.   (setq *error* stmerr)
  68.   (princ)
  69. )

  70. ;;加文字
  71. (defun addnb (n p1 p2)
  72.   (entmake (list '(0 . "TEXT")
  73.      (cons 1 (strcat (rtos n 2 0))) ;文字内容
  74.      (cons 10 p1)    ;文字中心点
  75.      (cons 11 p2)    ;文字中心点
  76.      (cons 40 160)    ;文字大小
  77.      (cons 62 2)    ;文字颜色
  78.      (cons 71 0)    ;0 = 默认 2 = 文字反向 4 = 文字倒置
  79.      (cons 72 2)    ;0 = 左对正;1 = 居中对正;2 = 右对正
  80.      (cons 73 1)    ;0 = 基线对正;1 = 底端对正;2 = 居中对正;3 = 顶端对正
  81.      )
  82.   )
  83. )


  84. ;;按esc键 结束程序
  85. (defun myerror (msg)
  86.   (if (wcmatch msg "*取消*")
  87.     (progn
  88.       (setq numb (1- numb))
  89.       (entdel e)
  90.     )
  91.   )
  92.   (princ (strcat "\n本次计数:" (rtos numb 2 0)))
  93.   (setq *error* stmerr)
  94. )
给你改好了,颜色和文字大小自己改一下,组码注释好了.
 楼主| 发表于 2022-5-12 12:21 | 显示全部楼层
戏男 发表于 2022-5-12 11:30
要能加前缀就好了,比如加个E后,就是E1,E2,E3等等下去


剩下有需求自己在论坛查资料,这么好的论坛,数据量很大,实在不懂可以发帖求助论坛的前辈、老师







本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2022-5-11 07:46 | 显示全部楼层
鎸塃SC鎴栫┖鏍兼垨鍥炶溅瀹屾垚璁℃暟.; 错误: no function definition: ADDNB
兄弟缺少东西吧
发表于 2022-5-11 10:25 | 显示全部楼层
非常感谢楼主分享好程序
 楼主| 发表于 2022-5-11 11:27 | 显示全部楼层
664571221 发表于 2022-5-11 07:46
鎸塃SC鎴栫┖鏍兼垨鍥炶溅瀹屾垚璁℃暟.; 错误: no function definition: ADDNB
兄弟缺少东西吧

朋友,我运行了没有问题,你不要点上面的 “复制代码”,从底部选上去复制。不然有注释会乱掉
 楼主| 发表于 2022-5-11 11:28 | 显示全部楼层

我试了点上面的 “复制代码”,到CAD就乱套了,你从底部选上去复制就可以的
发表于 2022-5-11 13:25 | 显示全部楼层
表骑马实开车 发表于 2022-5-11 11:27
朋友,我运行了没有问题,你不要点上面的 “复制代码”,从底部选上去复制。不然有注释会乱掉

还是用不了安你说的

点评

文件的编码改成GB18030  发表于 2022-5-11 13:48
 楼主| 发表于 2022-5-11 15:48 | 显示全部楼层
664571221 发表于 2022-5-11 13:25
还是用不了安你说的

我用没用问题,传了个文件上去,你试试
发表于 2022-5-11 16:04 | 显示全部楼层
要是能不要圆圈,可以输入起始数字,可以改颜色大小就好了
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2022-5-18 14:54 , Processed in 0.353710 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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