如何在一个属性块中的两个属性值按数递增

liushengri1 · 发表于 2014-10-1 16:40:21

论坛中都是单个属性值按数递增，我现在想在一个属性块中的两个属性（编号1，编号2）按数递增，如何实现？

eachy · 发表于 2014-10-1 17:01:22

(defun c:tt (/ ss k lst)
(if (and (setq ss (ssget '((66 . 1))))
(setq K (getint "\n起始号码:"))
)
(progn
(setq lst (mapcar '(lambda (x)
(list (last (xdrx_entity_box x))
x
)
)
(xdrx_pickset->ents ss)
)
lst (xd::list:tablesort lst 0 3 1e-3)
)
(mapcar
'(lambda (x)
(mapcar
'(lambda (a)
(mapcar
'(lambda (b)
(if (wcmatch (xdrx_getpropertyvalue b "tag")
"编号[1-2]"
)
(progn (xdrx_setpropertyvalue
b
"textstring"
(itoa k)
)
)
)
)
(xdrx_insert_getattribs a)
)
(setq k (1+ k))
)
(mapcar 'cadr x)
)
)
lst
)
)
)
(princ)
)

(defun c:tt (/ ss k lst) 
  (if (and (setq ss (ssget '((66 . 1)))) 
           (setq K (getint "\n起始号码:")) 
      ) 
    (progn 
      (setq lst        (mapcar        '(lambda (x) 
                           (list (last (xdrx_entity_box x)) 
                                 x 
                           ) 
                         ) 
                        (xdrx_pickset->ents ss) 
                ) 
            lst        (xd::list:tablesort lst 0 3 1e-3) 
      ) 
      (mapcar 
        '(lambda (x) 
           (mapcar 
             '(lambda (a) 
                (mapcar 
                  '(lambda (b) 
                     (if (wcmatch (xdrx_getpropertyvalue b "tag") 
                                  "编号[1-2]" 
                         ) 
                       (progn (xdrx_setpropertyvalue 
                                b 
                                "textstring" 
                                (itoa k) 
                              )                              
                       ) 
                     ) 
                   ) 
                  (xdrx_insert_getattribs a) 
                ) 
                (setq k (1+ k)) 
              ) 
             (mapcar 'cadr x) 
           ) 
         ) 
        lst 
      ) 
    ) 
  ) 
  (princ) 
)

liushengri1 · 发表于 2014-10-1 17:09:45

非常感谢eachy大师多次的帮助，真是太好了，要的就是这效果{:soso_e179:}

Free-Lancer · 发表于 2014-10-1 17:10:06

改编一下

(defun c:tt (/ ss k lst)
(fy:begin)
(if (and (ssget '((66 . 1)))
(setq K (getint "\n起始号码:"))
)
(progn
(setq lst (mapcar '(lambda (x)
(list (vlax-get x 'Insertionpoint)
x
)
)
(fy:cset->objs)
)
lst (xd::list:tablesort lst 0 3 1e-3)
)
(mapcar
'(lambda (x)
(mapcar
'(lambda (a)
(mapcar
'(lambda (b)
(if (wcmatch (vlax-get b 'tagstring)
"编号[1-2]"
)
(vlax-put b "textstring" (itoa k))
)
)
(vlax-invoke a 'getattributes)
)
(setq k (1+ k))
)
(mapcar 'cadr x)
)
)
lst
)
)
)
(fy:end)
(princ)
)

(defun c:tt (/ ss k lst) 
  (fy:begin) 
  (if (and (ssget '((66 . 1))) 
           (setq K (getint "\n起始号码:")) 
      ) 
    (progn 
      (setq lst        (mapcar        '(lambda (x) 
                           (list (vlax-get x 'Insertionpoint) 
                                 x 
                           ) 
                         ) 
                        (fy:cset->objs) 
                ) 
            lst        (xd::list:tablesort lst 0 3 1e-3) 
      ) 
      (mapcar 
        '(lambda (x) 
           (mapcar 
             '(lambda (a) 
                (mapcar 
                  '(lambda (b) 
                     (if (wcmatch (vlax-get b 'tagstring) 
                                  "编号[1-2]" 
                         ) 
                       (vlax-put b "textstring" (itoa k)) 
                     ) 
                   ) 
                  (vlax-invoke a 'getattributes) 
                ) 
                (setq k (1+ k)) 
              ) 
             (mapcar 'cadr x) 
           ) 
         ) 
        lst 
      ) 
    ) 
  ) 
  (fy:end) 
  (princ) 
)

XDSoft · 发表于 2014-10-1 18:10:26

liushengri1 发表于 2014-10-1 17:09
非常感谢eachy大师多次的帮助，真是太好了，要的就是这效果

把效果做个动画演示吧，我想批量处理肯定很方便了。

liushengri1 · 发表于 2014-10-3 13:05:27

问题是解决了，但排序有点乱，本来是想要：从左到右：1001 1002 1003 1004 再下一行是：1005 1006 1007 1008，结果变成了：1001 1003 1004 1002 1005 1007 1008 1006

st788796 · 发表于 2014-10-3 14:47:06

liushengri1 发表于 2014-10-3 13:05
问题是解决了，但排序有点乱，本来是想要：从左到右：1001 1002 1003 1004 再下一行是：1005 1006 1007 100 ...

调整索引点及容差

liushengri1 · 发表于 2014-10-3 15:40:09

容差是如何让计算的，1e-3是多少呀

csharp · 发表于 2014-10-3 15:59:13

liushengri1 发表于 2014-10-3 15:40
容差是如何让计算的，1e-3是多少呀

改成一个大图框高度试试

liushengri1 · 发表于 2014-10-3 16:29:32

试过了，不行

st788796 · 发表于 2014-10-3 18:15:35

本帖最后由 st788796 于 2014-10-3 18:19 编辑

liushengri1 发表于 2014-10-3 16:29
试过了，不行

以图框的左下角点作索引

(last (xdrx_entity_box x))
=>
(car (xdrx_entity_box x))

容差不够大索引位置不合适时实际排的是两行

liushengri1 · 发表于 2014-10-3 19:20:39

以图框的左下角点作索引

(last (xdrx_entity_box x))
=>
(car (xdrx_entity_box x))
试过了，还是不行，如上图框顺序变成了：1003 1001 1002 1004

newer · 发表于 2014-10-3 20:15:56

liushengri1 发表于 2014-10-3 19:20
以图框的左下角点作索引

(last (xdrx_entity_box x))

这帖子看着有点迷糊啊，不是问递增吗，怎么最后又排序了？

Free-Lancer · 发表于 2014-10-3 20:47:17

liushengri1 发表于 2014-10-3 19:20
以图框的左下角点作索引

(last (xdrx_entity_box x))

放大容差

(defun c:tt (/ ss k lst)
(fy:begin)
(if (and (ssget '((66 . 1))) (setq K (getint "\n起始号码:")))
(progn
(setq lst (mapcar '(lambda (x) (list (vlax-get x 'Insertionpoint) x))
(fy:cset->objs)
)
lst (xd::list:tablesort lst 0 3 40.)
)
(mapcar
'(lambda (x)
(mapcar
'(lambda (a)
(mapcar
'(lambda (b)
(if (wcmatch (vlax-get b 'tagstring) "编号[1-2]")
(progn
(vlax-put b "textstring" (itoa k))
(vla-update a)
)
)
)
(vlax-invoke a 'getattributes)
)
(setq k (1+ k))
)
(mapcar 'cadr x)
)
)
lst
)
)
)
(fy:end)
(princ)
)

(defun c:tt (/ ss k lst) 
  (fy:begin) 
  (if (and (ssget '((66 . 1))) (setq K (getint "\n起始号码:"))) 
    (progn 
      (setq lst        (mapcar        '(lambda (x) (list (vlax-get x 'Insertionpoint) x)) 
                        (fy:cset->objs) 
                ) 
            lst        (xd::list:tablesort lst 0 3 40.) 
      ) 
      (mapcar 
        '(lambda (x) 
           (mapcar 
             '(lambda (a) 
                (mapcar 
                  '(lambda (b) 
                     (if (wcmatch (vlax-get b 'tagstring) "编号[1-2]") 
                       (progn 
                         (vlax-put b "textstring" (itoa k)) 
                         (vla-update a) 
                       ) 
                     ) 
                   ) 
                  (vlax-invoke a 'getattributes) 
                ) 
                (setq k (1+ k)) 
              ) 
             (mapcar 'cadr x) 
           ) 
         ) 
        lst 
      ) 
    ) 
  ) 
  (fy:end) 
  (princ) 
)

liushengri1 · 发表于 2014-10-3 21:29:59

多谢Free-Lancer大师，现在可以了

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

[编程申请] 如何在一个属性块中的两个属性值按数递增

相关帖子

点评

点评

点评

点评

浏览过的版块