求助：框选编号

bpf19880325 · 发表于 2014-9-3 10:18:11

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

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

st788796 · 发表于 2014-9-3 10:54:40

(defun c:tt (/ ss lst i str nstr pos pre)
(if (setq ss (ssget '((0 . "text"))))
(progn
(setq lst (mapcar '(lambda (x)
(list (xdrx_getpropertyvalue x "Position") ;_ dxf 10
x
)
)
(xdrx_pickset->ents ss);_ss -> ents
)
lst (mapcar 'cadr
(vl-sort lst
'(lambda (x1 x2)
(if (equal (cadar x1) (cadar x2) 1e-6) ;_行左上
(< (caar x1) (caar x2))
(> (cadar x1) (cadar x2))
)
)
);_统一的可以直接写排序
)
i 1
)
(foreach x lst
(setq str (xdrx_getpropertyvalue x "Textstring") ;_dxf 1
pos (vl-string-search "-" str)
pre (substr str 1 (1+ pos))
nstr (strcat pre (itoa i))
i (1+ i)
)
(xdrx_setpropertyvalue x "TextString" nstr);_entmod dxf 1
)
)
)
(princ)
)

(defun c:tt (/ ss lst i str nstr pos pre) 
  (if (setq ss (ssget '((0 . "text")))) 
    (progn 
      (setq lst        (mapcar        '(lambda (x) 
                           (list (xdrx_getpropertyvalue x "Position") ;_ dxf 10 
                                 x 
                           ) 
                         ) 
                        (xdrx_pickset->ents ss);_ss -> ents 
                ) 
            lst        (mapcar        'cadr 
                        (vl-sort lst 
                                 '(lambda (x1 x2) 
                                    (if        (equal (cadar x1) (cadar x2) 1e-6) ;_行 左上 
                                      (< (caar x1) (caar x2)) 
                                      (> (cadar x1) (cadar x2)) 
                                    ) 
                                  ) 
                        );_统一的可以直接写排序 
                ) 
            i        1 
      ) 
      (foreach x lst 
        (setq str  (xdrx_getpropertyvalue x "Textstring") ;_dxf 1 
              pos  (vl-string-search "-" str) 
              pre  (substr str 1 (1+ pos)) 
              nstr (strcat pre (itoa i)) 
              i           (1+ i) 
        ) 
        (xdrx_setpropertyvalue x "TextString" nstr);_entmod dxf 1 
      ) 
    ) 
  ) 
  (princ) 
)

bpf19880325 · 发表于 2014-9-3 11:02:29

st788796 发表于 2014-9-3 10:54

大侠，请问下，，本程序是否需要加载一些函数库呢？在04版cad下运行出现：错误: no function definition: XDRX_PICKSET->ENTS，求教呀？

st788796 · 发表于 2014-9-3 11:11:55

bpf19880325 发表于 2014-9-3 11:02
大侠，请问下，，本程序是否需要加载一些函数库呢？在04版cad下运行出现：错误: no function definition: ...

需要加载 XDRXAPI 函数库，借用 API 定义的 Lisp 函数可以方便快速的写程序，建议下载
只用 A/Vlisp 就这样

(defun c:tt (/ ss lst i str nstr pos pre sl e)
(if (setq ss (ssget '((0 . "text"))))
(progn
(setq sl (sslength ss))
(while (setq e (ssname ss (setq sl (1- sl))))
(setq lst (cons (entget e) lst))
)
(setq lst (vl-sort
lst
'(lambda (x1 x2)
(if (equal (cadr (cdr (assoc 10 x1)))
(cadr (cdr (assoc 10 x2)))
1e-6
) ;_行左上
(< (car (cdr (assoc 10 x1)))
(car (cdr (assoc 10 x2)))
)
(> (cadr (cdr (assoc 10 x1)))
(cadr (cdr (assoc 10 x2)))
)
)
)
) ;_统一的可以直接写排序
i 1
)
(foreach x lst
(setq str (cdr (assoc 1 x)) ;_dxf 1
pos (vl-string-search "-" str)
pre (substr str 1 (1+ pos))
nstr (strcat pre (itoa i))
i (1+ i)
)
(entmod (append x (list (cons 1 nstr)))) ;_entmod dxf 1
)
)
)
(princ)
)

(defun c:tt (/ ss lst i str nstr pos pre sl e) 
  (if (setq ss (ssget '((0 . "text")))) 
    (progn 
      (setq sl (sslength ss)) 
      (while (setq e (ssname ss (setq sl (1- sl)))) 
        (setq lst (cons (entget e) lst)) 
      ) 
      (setq lst        (vl-sort 
                  lst 
                  '(lambda (x1 x2) 
                     (if (equal        (cadr (cdr (assoc 10 x1))) 
                                (cadr (cdr (assoc 10 x2))) 
                                1e-6 
                         ) ;_行 左上 
                       (< (car (cdr (assoc 10 x1))) 
                          (car (cdr (assoc 10 x2))) 
                       ) 
                       (> (cadr (cdr (assoc 10 x1))) 
                          (cadr (cdr (assoc 10 x2))) 
                       ) 
                     ) 
                   ) 
                ) ;_统一的可以直接写排序 
            i        1 
      ) 
      (foreach x lst 
        (setq str  (cdr (assoc 1 x)) ;_dxf 1 
              pos  (vl-string-search "-" str) 
              pre  (substr str 1 (1+ pos)) 
              nstr (strcat pre (itoa i)) 
              i           (1+ i) 
        ) 
        (entmod (append x (list (cons 1 nstr)))) ;_entmod dxf 1 
      ) 
    ) 
  ) 
  (princ) 
)

bpf19880325 · 发表于 2014-9-3 11:18:21

st788796 发表于 2014-9-3 11:11
需要加载 XDRXAPI 函数库，借用 API 定义的 Lisp 函数可以方便快速的写程序，建议下载
只用 A/Vlisp 就 ...

{:soso_e179:}太感谢你了，{:soso_e179:}研究一下先。原来希望用lisp通过ssget过滤掉非文本后获取文本群码，然后通过if 及repeat函数循环处理的，但是一直没弄出来，谢谢大侠啊

960322960322 · 发表于 2014-9-9 15:46:33

好强大啊，下来用用

960322960322 · 发表于 2014-9-9 15:47:41

和文修大师的一个功能类似

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

[编程申请] 求助：框选编号

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

点评

点评

浏览过的版块