动态数字增加

表骑马实开车 · 发表于 2022-5-10 21:33:00

本帖最后由表骑马实开车于 2022-5-11 15:48 编辑

(defun c:tt (/ stmerr numb e edt e1 edt1 cnd grd typ cdt pl)
(princ "\n按ESC或空格或回车完成计数.")
(setvar "cmdecho" 0)
(setq stmerr *error*)
(setq *error* myerror)
(setq numb 1)
(addnb numb '(0 0) '(0 0))
(setq e (entlast)
edt (entget e)
pl (getmid edt)
)
(addarc '(0 0) (cadr pl))
(setq e1 (entlast)
edt1 (entget e1)
)
(setq cnd T)
(while cnd
(setq grd (grread T 8))
(setq typ (car grd)
cdt (cadr grd)
)
(cond
;; 鼠标左键
((= typ 3)
(setq numb (1+ numb))
(addnb numb
(polar cdt 2.35 (+ (cadr pl) 80))
(polar cdt 2.35 (+ (cadr pl) 80))
)
(setq
e (entlast)
edt (entget e)
pl (getmid edt)
)
(addarc (polar cdt 2.35 (cadr pl)) (cadr pl))
(setq
e1 (entlast)
edt1 (entget e1)
)
)
;;11鼠标左键点击菜单栏,25鼠标右键
((or (= typ 11) (= typ 25))
(setq cnd nil
numb (1- numb)
)
(entdel e)
(entdel e1)
)
;; 空格、回车键
((or (equal grd '(2 32)) (equal grd '(2 13)))
(setq cnd nil
numb (1- numb)
)
(entdel e)
(entdel e1)
)
;; 鼠标移动
((= typ 5)
(setq
edt (subst (cons 10 (polar cdt 2.35 (+ (cadr pl) 80)))
(assoc 10 edt)
edt
)
edt (subst (cons 11 (polar cdt 2.35 (+ (cadr pl) 80)))
(assoc 11 edt)
edt
)
edt (subst (cons 1 (strcat (rtos numb 2 0)))
(assoc 1 edt)
edt
)
edt1 (subst (cons 10 (polar cdt 2.35 (+ (cadr pl) 80)))
(assoc 10 edt1)
edt1
)
)
(entmod edt)
(entmod edt1)
)
)
)
(princ (strcat "\n本次计数：" (rtos numb 2 0)))
(setq *error* stmerr)
(princ)
)
;;加文字
(defun addnb (n p1 p2)
(entmake (list '(0 . "TEXT")
(cons 1 (strcat (rtos n 2 0)))
(cons 10 p1)
(cons 11 p2)
(cons 40 160)
(cons 62 2)
(cons 71 0)
(cons 72 1)
(cons 73 2)
)
)
)
;;画圆
(defun addarc (m r)
(entmakex
(list '(0 . "CIRCLE") '(62 . 2) (cons 10 m) (cons 40 r))
)
)
;;文字包围框
;;By lee mac
(defun LM:textbox (enx / bpt hgt jus lst ocs org rot wid)
(cond
((and (= "ATTRIB" (cdr (assoc 000 enx)))
(= "Embedded Object" (cdr (assoc 101 enx)))
)
(LM:textbox
(cons '(000 . "MTEXT")
(member '(101 . "Embedded Object") enx)
)
)
)
((cond
((wcmatch (cdr (assoc 000 enx)) "ATTRIB,TEXT")
(setq bpt (cdr (assoc 010 enx))
rot (cdr (assoc 050 enx))
lst (textbox enx)
lst (list (car lst)
(list (caadr lst) (cadar lst))
(cadr lst)
(list (caar lst) (cadadr lst))
)
)
)
((= "MTEXT" (cdr (assoc 000 enx)))
(setq ocs (cdr (assoc 210 enx))
bpt (trans (cdr (assoc 010 enx)) 0 ocs)
rot (angle '(0.0 0.0) (trans (cdr (assoc 011 enx)) 0 ocs))
wid (cdr (assoc 042 enx))
hgt (cdr (assoc 043 enx))
jus (cdr (assoc 071 enx))
org (list (cond ((member jus '(2 5 8)) (/ wid -2.0))
((member jus '(3 6 9)) (- wid))
(0.0)
)
(cond ((member jus '(1 2 3)) (- hgt))
((member jus '(4 5 6)) (/ hgt -2.0))
(0.0)
)
)
lst (list org
(mapcar '+ org (list wid 0))
(mapcar '+ org (list wid hgt))
(mapcar '+ org (list 0 hgt))
)
)
)
)
((lambda (m)
(mapcar '(lambda (p) (mapcar '+ (mxv m p) bpt)) lst)
)
(list
(list (cos rot) (sin (- rot)) 0.0)
(list (sin rot) (cos rot) 0.0)
'(0.0 0.0 1.0)
)
)
)
)
)
;; 矩阵 x 向量
;;By lee mac
(defun mxv (m v)
(mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)
;;文字中心点/半径
(defun getmid (e / p m r)
(setq p (LM:textbox e)
m (inters (car p) (caddr p) (cadr p) (cadddr p))
r (+ (distance m (car p)) 6)
)
(list m r)
)
;;按esc键结束程序
(defun myerror (msg)
(if (wcmatch msg "*取消*")
(progn
(setq numb (1- numb))
(entdel e)
(entdel e1)
)
)
(princ (strcat "\n本次计数：" (rtos numb 2 0)))
(setq *error* stmerr)
)

(defun c:tt (/ stmerr numb e edt e1 edt1 cnd grd typ cdt pl) 
  (princ "\n按ESC或空格或回车完成计数.") 
  (setvar "cmdecho" 0) 
  (setq stmerr *error*) 
  (setq *error* myerror) 
  (setq numb 1) 
  (addnb numb '(0 0) '(0 0)) 
  (setq  e   (entlast) 
  edt (entget e) 
  pl  (getmid edt) 
  ) 
  (addarc '(0 0) (cadr pl)) 
  (setq  e1   (entlast) 
  edt1 (entget e1) 
  ) 
  (setq cnd T) 
  (while cnd 
    (setq grd (grread T 8)) 
    (setq typ (car grd) 
    cdt (cadr grd) 
    ) 
    (cond 
      ;; 鼠标左键 
      ((= typ 3) 
       (setq numb (1+ numb)) 
       (addnb numb 
        (polar cdt 2.35 (+ (cadr pl) 80)) 
        (polar cdt 2.35 (+ (cadr pl) 80)) 
       ) 
       (setq 
   e   (entlast) 
   edt (entget e) 
   pl  (getmid edt) 
       ) 
       (addarc (polar cdt 2.35 (cadr pl)) (cadr pl)) 
       (setq 
   e1   (entlast) 
   edt1 (entget e1) 
       ) 
      ) 
      ;;11鼠标左键点击菜单栏,25鼠标右键 
      ((or (= typ 11) (= typ 25)) 
       (setq cnd  nil 
       numb (1- numb) 
       ) 
       (entdel e) 
       (entdel e1) 
      ) 
 
      ;; 空格、回车键 
      ((or (equal grd '(2 32)) (equal grd '(2 13))) 
       (setq cnd  nil 
       numb (1- numb) 
       ) 
       (entdel e) 
       (entdel e1) 
      ) 
      ;; 鼠标移动 
      ((= typ 5) 
       (setq 
   edt  (subst (cons 10 (polar cdt 2.35 (+ (cadr pl) 80))) 
         (assoc 10 edt) 
         edt 
        ) 
   edt  (subst (cons 11 (polar cdt 2.35 (+ (cadr pl) 80))) 
         (assoc 11 edt) 
         edt 
        ) 
   edt  (subst (cons 1 (strcat (rtos numb 2 0))) 
         (assoc 1 edt) 
         edt 
        ) 
   edt1 (subst (cons 10 (polar cdt 2.35 (+ (cadr pl) 80))) 
         (assoc 10 edt1) 
         edt1 
        ) 
       ) 
       (entmod edt) 
       (entmod edt1) 
      ) 
    ) 
  ) 
  (princ (strcat "\n本次计数：" (rtos numb 2 0))) 
 
  (setq *error* stmerr) 
  (princ) 
) 
 
;;加文字 
(defun addnb (n p1 p2) 
  (entmake (list '(0 . "TEXT") 
     (cons 1 (strcat (rtos n 2 0))) 
     (cons 10 p1) 
     (cons 11 p2) 
     (cons 40 160) 
     (cons 62 2) 
     (cons 71 0) 
     (cons 72 1) 
     (cons 73 2) 
     ) 
  ) 
) 
 
 
;;画圆 
(defun addarc (m r) 
  (entmakex 
    (list '(0 . "CIRCLE") '(62 . 2) (cons 10 m) (cons 40 r)) 
  ) 
) 
 
;;文字包围框 
;;By lee mac 
(defun LM:textbox (enx / bpt hgt jus lst ocs org rot wid) 
  (cond 
    ((and (= "ATTRIB" (cdr (assoc 000 enx))) 
    (= "Embedded Object" (cdr (assoc 101 enx))) 
     ) 
     (LM:textbox 
       (cons '(000 . "MTEXT") 
       (member '(101 . "Embedded Object") enx) 
       ) 
     ) 
    ) 
    ((cond 
       ((wcmatch (cdr (assoc 000 enx)) "ATTRIB,TEXT") 
  (setq bpt (cdr (assoc 010 enx)) 
        rot (cdr (assoc 050 enx)) 
        lst (textbox enx) 
        lst (list  (car lst) 
      (list (caadr lst) (cadar lst)) 
      (cadr lst) 
      (list (caar lst) (cadadr lst)) 
      ) 
  ) 
       ) 
       ((= "MTEXT" (cdr (assoc 000 enx))) 
  (setq ocs (cdr (assoc 210 enx)) 
        bpt (trans (cdr (assoc 010 enx)) 0 ocs) 
        rot (angle '(0.0 0.0) (trans (cdr (assoc 011 enx)) 0 ocs)) 
        wid (cdr (assoc 042 enx)) 
        hgt (cdr (assoc 043 enx)) 
        jus (cdr (assoc 071 enx)) 
        org (list  (cond ((member jus '(2 5 8)) (/ wid -2.0)) 
            ((member jus '(3 6 9)) (- wid)) 
            (0.0) 
      ) 
      (cond ((member jus '(1 2 3)) (- hgt)) 
            ((member jus '(4 5 6)) (/ hgt -2.0)) 
            (0.0) 
      ) 
      ) 
        lst (list  org 
      (mapcar '+ org (list wid 0)) 
      (mapcar '+ org (list wid hgt)) 
      (mapcar '+ org (list 0 hgt)) 
      ) 
  ) 
       ) 
     ) 
     ((lambda (m) 
  (mapcar '(lambda (p) (mapcar '+ (mxv m p) bpt)) lst) 
      ) 
       (list 
   (list (cos rot) (sin (- rot)) 0.0) 
   (list (sin rot) (cos rot) 0.0) 
   '(0.0 0.0 1.0) 
       ) 
     ) 
    ) 
  ) 
) 
 
 
 
;; 矩阵 x 向量 
;;By lee mac 
(defun mxv (m v) 
  (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m) 
) 
 
;;文字中心点/半径 
(defun getmid (e / p m r) 
  (setq  p (LM:textbox e) 
  m (inters (car p) (caddr p) (cadr p) (cadddr p)) 
  r (+ (distance m (car p)) 6) 
  ) 
  (list m r) 
) 
 
 
;;按esc键 结束程序 
(defun myerror (msg) 
  (if (wcmatch msg "*取消*") 
    (progn 
      (setq numb (1- numb)) 
      (entdel e) 
      (entdel e1) 
    ) 
  ) 
  (princ (strcat "\n本次计数：" (rtos numb 2 0))) 
  (setq *error* stmerr) 
)

xyp1964 · 发表于 2022-5-12 14:24:57

表骑马实开车 · 发表于 2022-5-11 16:52:28

本帖最后由表骑马实开车于 2022-5-11 17:09 编辑

(defun c:tt (/ stmerr numb e edt cnd grd typ cdt)
(princ "\n按ESC或空格或回车完成计数.")
(setvar "cmdecho" 0)
(setq stmerr *error*)
(setq *error* myerror)
(or numb (setq numb 1))
(setq numb
(cond
((getreal (strcat "\n输入起始编号: 默认<"
(rtos numb 2 2)
">: "
)
)
)
(numb)
)
)
(addnb numb '(0 0) '(0 0))
(setq e (entlast)
edt (entget e)
)
(setq cnd T)
(while cnd
(setq grd (grread T 8))
(setq typ (car grd)
cdt (cadr grd)
)
;; 鼠标左键
(cond
((= typ 3)
(setq numb (1+ numb))
(addnb numb cdt cdt)
(setq
e (entlast)
edt (entget e)
)
)
;;11鼠标左键点击菜单栏,25鼠标右键
((or (= typ 11) (= typ 25))
(setq cnd nil
numb (1- numb)
)
(entdel e)
)
;; 空格、回车键
((or (equal grd '(2 32)) (equal grd '(2 13)))
(setq cnd nil
numb (1- numb)
)
(entdel e)
)
;; 鼠标移动
((= typ 5)
(setq
edt (subst (cons 10 cdt) (assoc 10 edt) edt)
edt (subst (cons 11 cdt) (assoc 11 edt) edt)
edt (subst (cons 1 (strcat (rtos numb 2 0)))
(assoc 1 edt)
edt
)
)
(entmod edt)
)
)
)
(princ (strcat "\n本次计数：" (rtos numb 2 0)))
(setq *error* stmerr)
(princ)
)
;;加文字
(defun addnb (n p1 p2)
(entmake (list '(0 . "TEXT")
(cons 1 (strcat (rtos n 2 0))) ;文字内容
(cons 10 p1) ;文字中心点
(cons 11 p2) ;文字中心点
(cons 40 160) ;文字大小
(cons 62 2) ;文字颜色
(cons 71 0) ;0 = 默认 2 = 文字反向 4 = 文字倒置
(cons 72 2) ;0 = 左对正；1 = 居中对正；2 = 右对正
(cons 73 1) ;0 = 基线对正；1 = 底端对正；2 = 居中对正；3 = 顶端对正
)
)
)
;;按esc键结束程序
(defun myerror (msg)
(if (wcmatch msg "*取消*")
(progn
(setq numb (1- numb))
(entdel e)
)
)
(princ (strcat "\n本次计数：" (rtos numb 2 0)))
(setq *error* stmerr)
)

(defun c:tt (/ stmerr numb e edt cnd grd typ cdt) 
  (princ "\n按ESC或空格或回车完成计数.") 
  (setvar "cmdecho" 0) 
  (setq stmerr *error*) 
  (setq *error* myerror) 
  (or numb (setq numb 1)) 
  (setq  numb 
   (cond 
     ((getreal (strcat "\n输入起始编号: 默认<" 
           (rtos numb 2 2) 
           ">: " 
         ) 
      ) 
     ) 
     (numb) 
   ) 
  ) 
  (addnb numb '(0 0) '(0 0)) 
  (setq  e   (entlast) 
  edt (entget e) 
  ) 
  (setq cnd T) 
  (while cnd 
    (setq grd (grread T 8)) 
    (setq typ (car grd) 
    cdt (cadr grd) 
    ) 
    ;; 鼠标左键 
    (cond 
      ((= typ 3) 
       (setq numb (1+ numb)) 
       (addnb numb cdt cdt) 
       (setq 
   e   (entlast) 
   edt (entget e) 
       ) 
      ) 
      ;;11鼠标左键点击菜单栏,25鼠标右键 
      ((or (= typ 11) (= typ 25)) 
       (setq cnd  nil 
       numb (1- numb) 
       ) 
       (entdel e) 
      ) 
 
      ;; 空格、回车键 
      ((or (equal grd '(2 32)) (equal grd '(2 13))) 
       (setq cnd  nil 
       numb (1- numb) 
       ) 
       (entdel e) 
      ) 
      ;; 鼠标移动 
      ((= typ 5) 
       (setq 
   edt (subst (cons 10 cdt) (assoc 10 edt) edt) 
   edt (subst (cons 11 cdt) (assoc 11 edt) edt) 
   edt (subst (cons 1 (strcat (rtos numb 2 0))) 
        (assoc 1 edt) 
        edt 
       ) 
       ) 
       (entmod edt) 
      ) 
    ) 
  ) 
  (princ (strcat "\n本次计数：" (rtos numb 2 0))) 
  (setq *error* stmerr) 
  (princ) 
) 
 
;;加文字 
(defun addnb (n p1 p2) 
  (entmake (list '(0 . "TEXT") 
     (cons 1 (strcat (rtos n 2 0))) ;文字内容 
     (cons 10 p1)    ;文字中心点 
     (cons 11 p2)    ;文字中心点 
     (cons 40 160)    ;文字大小 
     (cons 62 2)    ;文字颜色 
     (cons 71 0)    ;0 = 默认 2 = 文字反向 4 = 文字倒置 
     (cons 72 2)    ;0 = 左对正；1 = 居中对正；2 = 右对正 
     (cons 73 1)    ;0 = 基线对正；1 = 底端对正；2 = 居中对正；3 = 顶端对正 
     ) 
  ) 
) 
 
 
;;按esc键 结束程序 
(defun myerror (msg) 
  (if (wcmatch msg "*取消*") 
    (progn 
      (setq numb (1- numb)) 
      (entdel e) 
    ) 
  ) 
  (princ (strcat "\n本次计数：" (rtos numb 2 0))) 
  (setq *error* stmerr) 
)

给你改好了，颜色和文字大小自己改一下，组码注释好了.

表骑马实开车 · 发表于 2022-5-12 12:21:31

戏男发表于 2022-5-12 11:30
要能加前缀就好了，比如加个E后，就是E1,E2,E3等等下去

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

664571221 · 发表于 2022-5-11 07:46:25

鎸塃SC鎴栫┖鏍兼垨鍥炶溅瀹屾垚璁℃暟.; 错误: no function definition: ADDNB
兄弟缺少东西吧

戏男 · 发表于 2022-5-11 08:49:05

用不了呢？

669423907 · 发表于 2022-5-11 10:25:18

非常感谢楼主分享好程序

表骑马实开车 · 发表于 2022-5-11 11:27:01

664571221 发表于 2022-5-11 07:46
鎸塃SC鎴栫┖鏍兼垨鍥炶溅瀹屾垚璁℃暟.; 错误: no function definition: ADDNB
兄弟缺少东西吧

朋友，我运行了没有问题，你不要点上面的 “复制代码”，从底部选上去复制。不然有注释会乱掉

表骑马实开车 · 发表于 2022-5-11 11:28:23

戏男发表于 2022-5-11 08:49
用不了呢？

我试了点上面的 “复制代码”，到CAD就乱套了，你从底部选上去复制就可以的

664571221 · 发表于 2022-5-11 13:25:41

表骑马实开车发表于 2022-5-11 11:27
朋友，我运行了没有问题，你不要点上面的 “复制代码”，从底部选上去复制。不然有注释会乱掉

还是用不了安你说的

表骑马实开车 · 发表于 2022-5-11 15:48:29

664571221 发表于 2022-5-11 13:25
还是用不了安你说的

我用没用问题，传了个文件上去，你试试

戏男 · 发表于 2022-5-11 16:04:43

要是能不要圆圈，可以输入起始数字，可以改颜色大小就好了

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

[已解答] 动态数字增加

本帖子中包含更多资源

评分

本帖子中包含更多资源

本帖子中包含更多资源

点评