用于更改日期的一个程序(源代码)

xiaping

一个用于日期更改的程序：
点击需要更改的日期后，自动更换为当前日期。

2. 
   
3.   [FONT=courier new]
   
4. (defun c:tt1 ( / e ee hr m n s sdate ss ti time1 tmp tmp1);;;批量更改最后修改日期
   
5.   (VL-LOAD-COM)
   
6.   (SETQ sdate (rtos (GETVAR "CDATE")))
   
7.   (SETQ sdate (SUBSTR sdate 1 8))
   
8.   (setq        tmp1 (STRCAT (SUBSTR sdate 1 4)
   
9.                     "."
   
10.                     (SUBSTR sdate 5 2)
    
11.                     "."
    
12.                     (SUBSTR sdate 7 2)
    
13.             )
    
14.   )
    
15.   (setq hd nil)
    
16.   (setq hd (getstring"\n  单个修改/全部修改  D/Q <D>"))
    
17.   (if (not hd)(setq hd "D"))
    
18.   (if(= hd "q")(setq hd "Q"))
    
19.   (cond((= hd "D")   
    
20.   (setq ss (ssget ":s" '((0 . "text"))))
    
21.   (if ss
    
22.         (progn
    
23.                 (setq obj (vlax-ename->vla-object (ssname ss 0)))
    
24.                 (vla-put-TextString Obj tmp1))
    
25.         (progn
    
26.            (princ"\n 没有选中任何对象。")
    
27.            (princ)))
    
28.         (setq ss nil))
    
29.        ((= hd "Q")
    
30.   (setq ss (ssget ":s" '((0 . "text"))))
    
31.   (if ss
    
32.         (progn
    
33.                 (setq obj (vlax-ename->vla-object (ssname ss 0)))
    
34.                 (setq txt0 (vla-get-TextString Obj))
    
35.                 
    
36.           )
    
37.         (progn
    
38.            (princ"\n 没有选中任何对象。")
    
39.            (princ)))
    
40.   (setq ss (ssget "X" '((0 . "text"))) n 0)
    
41.   (if ss
    
42.         (progn
    
43.               (while (< n (sslength ss)) **********
    
44.                 (setq obj (vlax-ename->vla-object (ssname ss n)))
    
45.                 (if(= txt0 (vla-get-TextString Obj))(vla-put-TextString Obj tmp1))
    
46.                 (setq n (1+ n))
    
47.               )
    
48.           )
    
49.         (progn
    
50.            (princ"\n 没有选中任何对象。")
    
51.            (princ)))))
    
52. )
    
53.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun c:tt1 ( / e ee hr m n s sdate ss ti time1 tmp tmp1);;;批量更改最后修改日期<br />   (VL-LOAD-COM)<br />   (SETQ sdate (rtos (GETVAR "CDATE")))<br />   (SETQ sdate (SUBSTR sdate 1 8))<br />   (setq        tmp1 (STRCAT (SUBSTR sdate 1 4)<br />                     "."<br />                     (SUBSTR sdate 5 2)<br />                     "."<br />                     (SUBSTR sdate 7 2)<br />             )<br />   )<br />   (setq hd nil)<br />   (setq hd (getstring"\n  单个修改/全部修改  D/Q <D>"))<br />   (if (not hd)(setq hd "D"))<br />   (if(= hd "q")(setq hd "Q"))<br />   (cond((= hd "D")   <br />   (setq ss (ssget ":s" '((0 . "text"))))<br />   (if ss <br />         (progn<br />                 (setq obj (vlax-ename->vla-object (ssname ss 0)))<br />                 (vla-put-TextString Obj tmp1))<br />         (progn<br />            (princ"\n 没有选中任何对象。")<br />            (princ)))<br />         (setq ss nil))<br />        ((= hd "Q")<br />   (setq ss (ssget ":s" '((0 . "text"))))<br />   (if ss <br />         (progn<br />                 (setq obj (vlax-ename->vla-object (ssname ss 0)))<br />                 (setq txt0 (vla-get-TextString Obj))<br />                 <br />           )<br />         (progn<br />            (princ"\n 没有选中任何对象。")<br />            (princ))) <br />   (setq ss (ssget "X" '((0 . "text"))) n 0)<br />   (if ss<br />         (progn<br />               (while (< n (sslength ss)) **********<br />                 (setq obj (vlax-ename->vla-object (ssname ss n)))<br />                 (if(= txt0 (vla-get-TextString Obj))(vla-put-TextString Obj tmp1))<br />                 (setq n (1+ n))<br />               )<br />           )<br />         (progn<br />            (princ"\n 没有选中任何对象。")<br />            (princ)))))<br /> )<br />   [/FONT]<br />

LUCAS

2. 
   
3. ;;各位版主高手。我編了一個程序，目的是點擊某一個日期標注值以
   
4. ;;後批量將各個佈局中相同的日期用當前日期進行替換。
   
5. ;;現在的問題是：經使用發現無法實現多佈局中相同文字的替換，
   
6. ;;只對所點擊的佈局中的文字日期有效。不知何故，請各位指點謎經。
   
7. ;;難道ssget函數只對單一佈局起作用嗎？？？？
   
8. (defun C:TT1 (/ HOLDECHO HD N OBJ SDATE SS TMP1 TXT0)
   
9.   ;;批量更改最後修改日期
   
10.   (vl-load-com)
    
11.   (setq HOLDECHO (getvar "CMDECHO"))
    
12.   (setvar "CMDECHO" 0)
    
13.   (command "_.UNDO" "_GROUP")
    
14.   (setq SDATE (rtos (getvar "CDATE")))
    
15.   (setq SDATE (substr SDATE 1 8))
    
16.   (setq        TMP1 (strcat (substr SDATE 1 4)
    
17.                      "."
    
18.                      (substr SDATE 5 2)
    
19.                      "."
    
20.                      (substr SDATE 7 2)
    
21.              )
    
22.   )
    
23.   (initget "A ")
    
24.   (setq HD (getkword "\n  全部修改(A)/單個修改(ENTER): "))
    
25.   (if (setq SS (ssget ":S:E" '((0 . "text"))))
    
26.     (progn
    
27.       (setq OBJ (vlax-ename->vla-object (ssname SS 0)))
    
28.       (cond
    
29.         ((= HD NIL)
    
30.          (vla-put-textstring OBJ TMP1)
    
31.         )
    
32.         ((= HD "A")
    
33.          (setq TXT0 (vla-get-textstring OBJ))
    
34.          (setq SS (ssget "X" '((0 . "text")))
    
35.                N  0
    
36.          )
    
37.          (while        (< N (sslength SS))
    
38.            (setq OBJ (vlax-ename->vla-object (ssname SS N)))
    
39.            (if (= TXT0 (vla-get-textstring OBJ))
    
40.              (vla-put-textstring OBJ TMP1)
    
41.            )
    
42.            (setq N (1+ N))
    
43.          )
    
44.         )
    
45.       )
    
46.     )
    
47.     (princ "\n 沒有選中任何對象。")
    
48.   )
    
49.   (command "_.UNDO" "_END")
    
50.   (setvar "CMDECHO" HOLDECHO)
    
51.   (princ)
    
52. )
    

<br /> ;;各位版主高手。我編了一個程序，目的是點擊某一個日期標注值以<br /> ;;後批量將各個佈局中相同的日期用當前日期進行替換。<br /> ;;現在的問題是：經使用發現無法實現多佈局中相同文字的替換，<br /> ;;只對所點擊的佈局中的文字日期有效。不知何故，請各位指點謎經。<br /> ;;難道ssget函數只對單一佈局起作用嗎？？？？<br /> (defun C:TT1 (/ HOLDECHO HD N OBJ SDATE SS TMP1 TXT0)<br />   ;;批量更改最後修改日期<br />   (vl-load-com)<br />   (setq HOLDECHO (getvar "CMDECHO"))<br />   (setvar "CMDECHO" 0)<br />   (command "_.UNDO" "_GROUP")<br />   (setq SDATE (rtos (getvar "CDATE")))<br />   (setq SDATE (substr SDATE 1 8))<br />   (setq        TMP1 (strcat (substr SDATE 1 4)<br />                      "."<br />                      (substr SDATE 5 2)<br />                      "."<br />                      (substr SDATE 7 2)<br />              )<br />   )<br />   (initget "A ")<br />   (setq HD (getkword "\n  全部修改(A)/單個修改(ENTER): "))<br />   (if (setq SS (ssget ":S:E" '((0 . "text"))))<br />     (progn<br />       (setq OBJ (vlax-ename->vla-object (ssname SS 0)))<br />       (cond<br />         ((= HD NIL)<br />          (vla-put-textstring OBJ TMP1)<br />         )<br />         ((= HD "A")<br />          (setq TXT0 (vla-get-textstring OBJ))<br />          (setq SS (ssget "X" '((0 . "text")))<br />                N  0<br />          )<br />          (while        (< N (sslength SS))<br />            (setq OBJ (vlax-ename->vla-object (ssname SS N)))<br />            (if (= TXT0 (vla-get-textstring OBJ))<br />              (vla-put-textstring OBJ TMP1)<br />            )<br />            (setq N (1+ N))<br />          )<br />         )<br />       )<br />     )<br />     (princ "\n 沒有選中任何對象。")<br />   )<br />   (command "_.UNDO" "_END")<br />   (setvar "CMDECHO" HOLDECHO)<br />   (princ)<br /> )<br />

xiaping

十分感谢版主的回复。可以很好的运行了。
还要请教一个问题：(ssget ":S:E" '((0 . "text")))  语句中 ":s:e" :s是指定单选，:e 起何作用？类似的使用在ssget 函数中的参数还有吗？

LUCAS

:S是指定单选,但選不到會變成框選,加了:E才是真的單選

Which one of the three parameters is (ssget) complaining about?

(ssget "+." '((0 . "ARC")))
(ssget ":E" '((0 . "ARC")))
(ssget ":S" '((0 . "ARC")))


Since "+." is undocumented, that might be the trouble; it may have never
made it to the French version.

If that is the case, you can emulate the same behavior by setting PickAuto=0
for the duration of the (ssget).



:E  游標物件選擇選取框內的所有物件。
:S  僅允許單選。
(ssget "+.:E:S" '((0 . "ARC")))
(Stig Madsen clued me in on the "+." option!)
How about ":L" for ignoring locked layers?

(ssget) options
Some of these are undocumented.
A   All
B   Box
C   Crossing
CP  Crossing Polygon
:D  Duplicates 可覆選
:E  Everything in aperture
F   Fence
G   Groups (無效)
I   Implied  ;;'I' selects all 'gripped' entities:
L   Last
:L  Rejects locked layers
M   Multiple
:N  Nested 選子物件(圖塊)
P   Previous
:P  Rejects Viewport (無效)
:S  Force single object selection only
W   Window
WP  Window Polygon
X   Extended search (search whole database)


;; allow single entity selection with a filter!
;; Courtsey of Robert Bell
(ssget "+.:E:S" '((0 . "ARC")))

xiaping

谢谢指点，这些资料的确难得找到。值得收藏。