acad复制递增lsp源码分享 [复制链接]

转载自网上，注释中有作者信息。
作用：复制一个编号时，自动递增，支持代前缀的编号。

;;;(jun-dz 图元名 递增值 插入点)
(defun jun-dz(dname x zuobiao / dxh dxname dxs ndx)
    (setq dxname (entget dname)
            ndx (cdr (assoc 1 dxname))
            dxs (car (reverse (test ndx))))
    (if dxs
        (progn
          (setq dxh (strcat (substr ndx 1 (- (strlen ndx) (strlen (itoa dxs)))) (itoa (+  dxs x)))
                dxname (subst (cons 72 0) (assoc 72 dxname) dxname)
               dxname (subst (cons 10 zuobiao) (assoc 10 dxname) dxname)
              dxname (subst (cons 11 zuobiao) (assoc 11 dxname) dxname)
                dxname (subst (cons 1 dxh) (assoc 1 dxname) dxname)
          )
          (entmake dxname)
)
    )
  
)
(defun c:cn( / en pointx)
  (setq en (car (entsel "\n请选择文本：")))
  (setq pointx (getpoint  "\n输入插入点："))
  (while pointx
  (jun-dz en 1 pointx)
  (setq en (entlast))
  (setq pointx (getpoint pointx  "\n输入插入点："))
  )
  
)
;下面引用caoyin的一段源码（在此表示感谢）
;字符串处理（如果字符串中不含小数点）：
(defun TEST (STR)
  (read (strcat "("(vl-list->string
  (mapcar '(lambda (X) (if (<= 48 X 57) X 32))
          (vl-string->list STR)
  ))")"))
)

;;如有类同，纯属巧合。

抢个沙发！

似乎很有用处，先备用了~感谢LZ分享