快速以时间命名建块（怎样再时间前面加前缀如LZ_时间）？

9701519

快速以时间命名建块（怎样再时间前面加前缀如LZ_时间）？





(defun C:lz_bm (/ SS PT DOC BLKS I OBJ LST)
  (if (and (setq SS (ssget))
           (setq PT (getpoint "\n指定插入点: "))
      )
    (progn
      (setq DOC  (vla-get-ActiveDocument (vlax-get-acad-object))
            BLKS (vla-get-blocks DOC)
            PT   (vlax-3d-point (trans PT 1 0))
      )
      (repeat (setq I (sslength SS))
        (setq I   (1- I)
              OBJ (vlax-ename->vla-object (ssname SS I))
              LST (cons OBJ LST)
        )
        (vla-put-layer OBJ "0")
      )
      (vlax-invoke DOC
                  'CopyObjects
                  LST
                  (setq BLK (vla-add BLKS PT(getvar 'cdate)))
      )
      (vla-InsertBlock
        (if (= (getvar 'cvport) 1)
          (vla-get-PaperSpace DOC)
          (vla-get-ModelSpace DOC)
        )
        PT (vla-get-name BLK) 1 1 1 0
      )
      (mapcar 'vla-delete LST)
    )
  )
  (princ)

xyp1964

2. ;; 快速以时间命名建块
   
3. (defun c:tt (/ ss pt doc bn blks i obj lst)
   
4.   (if (and (setq ss (ssget))
   
5.            (setq pt (getpoint "\n指定插入点: "))
   
6.       )
   
7.     (progn
   
8.       (setq doc         (vla-get-activedocument (vlax-get-acad-object))
   
9.             blks (vla-get-blocks doc)
   
10.             pt         (vlax-3d-point (trans pt 1 0))
    
11.             bn         (strcat "lz_" (rtos (* (getvar 'cdate) 1e6) 2 0))
    
12.             mps         (if (= (getvar 'cvport) 1)
    
13.                    (vla-get-paperspace doc)
    
14.                    (vla-get-modelspace doc)
    
15.                  )
    
16.             blk         (vla-add blks pt bn)
    
17.             i         (sslength ss)
    
18.       )
    
19.       (repeat i
    
20.         (setq i          (1- i)
    
21.               obj (vlax-ename->vla-object (ssname ss i))
    
22.               lst (cons obj lst)
    
23.         )
    
24.         (vla-put-layer obj "0")
    
25.       )
    
26.       (vlax-invoke doc 'copyobjects lst blk)
    
27.       (vla-insertblock mps pt bn 1 1 1 0)
    
28.       (mapcar 'vla-delete lst)
    
29.     )
    
30.   )
    
31.   (princ)
    
32. )

;; 快速以时间命名建块<br /> (defun c:tt (/ ss pt doc bn blks i obj lst)<br />   (if (and (setq ss (ssget))<br />            (setq pt (getpoint "\n指定插入点: "))<br />       )<br />     (progn<br />       (setq doc         (vla-get-activedocument (vlax-get-acad-object))<br />             blks (vla-get-blocks doc)<br />             pt         (vlax-3d-point (trans pt 1 0))<br />             bn         (strcat "lz_" (rtos (* (getvar 'cdate) 1e6) 2 0))<br />             mps         (if (= (getvar 'cvport) 1)<br />                    (vla-get-paperspace doc)<br />                    (vla-get-modelspace doc)<br />                  )<br />             blk         (vla-add blks pt bn)<br />             i         (sslength ss)<br />       )<br />       (repeat i<br />         (setq i          (1- i)<br />               obj (vlax-ename->vla-object (ssname ss i))<br />               lst (cons obj lst)<br />         )<br />         (vla-put-layer obj "0")<br />       )<br />       (vlax-invoke doc 'copyobjects lst blk)<br />       (vla-insertblock mps pt bn 1 1 1 0)<br />       (mapcar 'vla-delete lst)<br />     )<br />   )<br />   (princ)<br /> )

9701519

xyp1964 发表于 2015-6-4 19:05

谢谢！！！！！！！！

sicky111

好像G版以前写过

筑巢architect

9701519 发表于 2015-6-5 09:24
谢谢！！！！！！！！

请问 为什么我输入TT  无法调用它啊

hooboxu

加了前缀是为也方便选取吗？