[编程交流] lisp编码帮助

 
; Function(s): makestamp: Allows user to place a date/time stamp. 
; upstamp: Auto-updates an existing date/time stamp.
; type makestamp at the AutoCAD command prompt to run or upstamp to update 
(defun c:makestamp () ;creates new stamp in drawing
(setq pt (getpoint "\nPick a point: "))
;(setq curdate (menucmd "M=$(edtime, $(getvar,date),YY-MM-DD)"))
(setq curdate (getvar "CDATE"))
(setq curdate (rtos curdate 2 4))
(setq year (substr curdate 3 2))
(setq month (substr curdate 5 2))
(setq day (substr curdate 7 2))
(setq curdate (strcat year "-" month "-" day))
(setq object (list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 67 0)
(cons 410 (getvar "ctab")) ;gets current layout.
(cons 8 "TIMESTAMP") ;puts on this layer, used to identify in next lisp for updating. Do NOT CHANGE!!!!
;every time. Or on your print button, right before you put the little command for this lisp, you
;may want to issue a change clayer to the correct text layer for this.
(cons 100 "AcDbText")
(cons 10
(list (car pt)(cadr pt)(caddr pt)
)
)
(cons 40 (getvar "textsize"))
(cons 1 curdate)
(cons 50 (* 00 (/ pi 180)))
(cons 41 1.0)
(cons 51 0)
(cons 7 (getvar "cmlstyle"));gets current multi-line style
(cons 71 0)
(cons 72 0)
(cons 100 "AcDbText")
(cons 73 0) 
)
)
(entmake object)
(princ)
)
; upstamp: Auto-updates an existing date/time stamp.
(defun c:upstamp ()
;(setq curdate2 (menucmd "M=$(edtime, $(getvar,date),YY-MM-DD)"))
(setq curdate2 (getvar "CDATE"))
(setq curdate2 (rtos curdate2 2 4))
(setq year (substr curdate2 3 2))
(setq month (substr curdate2 5 2))
(setq day (substr curdate2 7 2))
(setq curdate2 (strcat year "-" month "-" day))
(setq ssup (ssget "x" (list (cons 8 "TIMESTAMP")))) ;gets the only entity on the TIMESTAMP layer
(setq count (sslength ssup)) ;test to see how many entities are on the TIMESTAMP layer. If count = 0, then lisp errors out.
(if (= count 1) 
(progn
(setq b1 (entget (ssname ssup 0))) ;if only one entity exist then the lisp updates the to the current time/date
(setq c (assoc 1 b1))
(setq d (cons (car c) curdate2))
(setq b2 (subst d c b1))
(entmod b2)
)
(progn ;if there is more than one entity on that layer, then lisp alerts user. 
(alert "ERROR: You have more than one entity on the TIMESTAMP layer.")
(quit)
)
)
(princ)
)

 
; Function(s): makestamp: Allows user to place a date/time stamp. 
; upstamp: Auto-updates an existing date/time stamp.
; type makestamp at the AutoCAD command prompt for new stamp or upstamp to update and save file. 
(defun c:makestamp () ;creates new stamp in drawing
(setq pt (getpoint "\nPick a point: "))
;(setq curdate (menucmd "M=$(edtime, $(getvar,date),YY-MM-DD)")) ; commented out
; Next section gets the current date from the system, converts it to a string
; and defines substrings for the year, month and day.
(setq curdate (getvar "CDATE"))
(setq curdate (rtos curdate 2 4))
(setq year (substr curdate 3 2))
(setq month (substr curdate 5 2))
(setq day (substr curdate 7 2))
; Next line concatenates five substrings into the date format YY-MM-DD 
(setq curdate (strcat year "-" month "-" day))
(setq object (list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 67 0)
(cons 410 (getvar "ctab")) ; gets current layout.
(cons 8 "TIMESTAMP") ; puts on this layer, used to identify in next lisp for updating. Do NOT CHANGE!!!!
; every time. Or on your print button, right before you put the little command for this lisp, you
; may want to issue a change clayer to the correct text layer for this.
(cons 100 "AcDbText")
(cons 10
(list (car pt)(cadr pt)(caddr pt)
)
)
(cons 40 (getvar "textsize"))
(cons 1 curdate)
(cons 50 (* 00 (/ pi 180)))
(cons 41 1.0)
(cons 51 0)
(cons 7 (getvar "cmlstyle")) ; gets current multi-line style
(cons 71 0)
(cons 72 0)
(cons 100 "AcDbText")
(cons 73 0) 
)
)
(entmake object)
(princ)
)
; upstamp: Auto-updates an existing date/time stamp.
(defun c:upstamp ()
;(setq curdate2 (menucmd "M=$(edtime, $(getvar,date),YY-MM-DD)")) - commented out
; Next section gets the current date from the system, converts it to a string
; and defines substrings for the year, month and day.
(setq curdate2 (getvar "CDATE"))
(setq curdate2 (rtos curdate2 2 4))
(setq year (substr curdate2 3 2))
(setq month (substr curdate2 5 2))
(setq day (substr curdate2 7 2))
; Next line concatenates five substrings into the date format YY-MM-DD 
(setq curdate2 (strcat year "-" month "-" day))
(setq ssup (ssget "x" (list (cons 8 "TIMESTAMP")))) ; gets the only entity on the TIMESTAMP layer
(setq count (sslength ssup)) ; test to see how many entities are on the TIMESTAMP layer. If count = 0, then lisp errors out.
(if (= count 1) 
(progn
(setq b1 (entget (ssname ssup 0))) ; if only one entity exist then the lisp updates the to the current time/date
(setq c (assoc 1 b1))
(setq d (cons (car c) curdate2))
(setq b2 (subst d c b1))
(entmod b2)
)
(progn ; if there is more than one entity on that layer, then lisp alerts user. 
(alert "ERROR: You have more than one entity on the TIMESTAMP layer.")
(quit)
)
)
(command ".QSAVE") ; quick save the file - asks for filename only if first save
(princ)
)