求一框选编号的程序

bpf19880323

由于选择了一个需要大量编号的专业，编号繁琐又没啥技术含量，原来在明经学过一阵子，也尝试的编过一些简单的小代码，但是对于这个自己想要的程序，真心不知道从哪里开始，工作也忙，现厚着脸皮来此求程序，望大侠们帮帮忙呀。
  希望的程序：款选一些编号（存文本，非属性块），编号末尾数值按顺序编号。

Kye

;;;把LLXXZZ大侠大作读完才发现对自己没有用，白忙活一个礼拜

;;程序来源于LLXXZZ大侠
;;;http://bbs.mjtd.com/thread-89140-1-1.html
(defun C:test (/  SS    SSLIST   index  INDEX0    SSLIST-PTL
        TMP-PT  XZ_SORTLIST      ENTLIST   N
        ED
       )
  (setvar "CMDECHO" 0)
  (setq ss (ssget '((0 . "TEXT"))))

;_选择集=>图元列表
  (setq sslist (MJ:SS->EntList ss))

;_开始构建图元点位表

(setq index (sslength ss) );

  (setq index0 0
sslist-ptl
  '()
tmp-pt '()
  )
  (repeat index
    (setq tmp-pt
    (cons
      (nth index0 sslist)
      (cons (cdr (assoc 10 (entget (nth index0 sslist)))) tmp-pt)
    )
    )
    (setq sslist-ptl (cons tmp-pt sslist-ptl))
    (setq tmp-pt '())
    (setq index0 (1+ index0))
  )
;_从左到右从上到下
  
  (setq XZ_sortlist
  (vl-sort
    (vl-sort sslist-ptl
      '(lambda (s1 s2) (> (cadadr s1) (cadadr s2)))
    )
    '(lambda (s3 s4)
       (if (equal (cadadr s3) (cadadr s4) 0.6)
  (< (caadr s3) (caadr s4))
       )
     )
  )
  )

  (setq entlist (mapcar '(lambda (x) (car x)) XZ_sortlist))
;_更新文本数据
  (setq n 1)
  (mapcar '(lambda (x)
      (setq ed (entget x))
      (setq ed (subst (cons 1 (strcat "YL-" (VL-PRINC-TO-STRING n)))
        (assoc 1 ed)
        ed
        )
      )
      (setq n (1+ n))
      (entmod ed)
    )
   entlist
  )
  (princ)
)


;_选择集=>图元列表
(defun MJ:SS->EntList (ss / retu) ;_By caiqs
  (setq retu (apply 'append (ssnamex ss)))
  (setq retu (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) retu))
)

bpf19880323

给自己顶一下，希望大侠们帮帮忙呀。

wangshuping42

这个不算难啊，自己琢磨一下吧，vba可实现

bpf19880323

wangshuping42 发表于 2014-9-2 15:33
这个不算难啊，自己琢磨一下吧，vba可实现

一点思路都没有哦   ，要从哪里开始呢？

wangshuping42

bpf19880323 发表于 2014-9-2 16:48
一点思路都没有哦   ，要从哪里开始呢？

简单地说
框选不是得到选择集吗，然后过滤掉非文本和不是指定格式的文本，得到文本数组，遍历每个元素，挨个修改textstring属性。

bpf19880323

Kye 发表于 2014-9-3 16:41
;;;把LLXXZZ大侠大作读完才发现对自己没有用，白忙活一个礼拜

;;程序来源于LLXXZZ大侠

大侠，非常感谢