Code Red > AutoLISP (Vanilla / Visual)
How to run a lisp when close file ?
HasanCAD:
Hi all
I started this lisp but need some help
Usage of lisp:
To create the file history
Search for a text start with "Save Date *"
if yes find the last one and insert new text under the last one
if no alert the user to pick a point to insert new text
Questions:
Q1: How to run this lisp when close the file?
Q2: In if condition How to search for a text start with "Save Date *" and if there more than one select the last to insert the new text under it ?
The code
--- Code: ---(defun c:FileHistory (/)
;Get time and date
;Afralisp
(setq d (rtos (getvar "CDATE") 2 6)
yr (substr d 1 4) ;extract the year
mo (substr d 5 2) ;extract the month
dy (substr d 7 2) ;extract the day
hr (substr d 10 2);extract the hour
m (substr d 12 2);extract the minute
Sdate (strcat "Save Date: "(strcat dy "/" mo "/" yr))
Stime (strcat " Time: "(strcat hr ":" m ))
SUser (strcat " User: "(getvar "loginname"))
SStr (strcat Sdate Stime SUser)
)
(if ()
(progn
(setq Tpt )
(maketext SStr Tpt 4000)
)
(Progn
(alert (strcat "Pick a point to Insert file history"))
(setq Tpt (getpoint))
(maketext SStr Tpt 4000)
)))
(defun maketext (str pt ht )
(entmakex (list (cons 0 "TEXT") ;***
(cons 1 str) ;* (the string itself)
(cons 6 "BYLAYER") ; Linetype name
(cons 7 (getvar "TEXTSTYLE")) ;* Text style name, defaults to STANDARD, current
(cons 8 (getvar "CLAYER")) ; layer
(cons 10 pt) ;* First alignment point (in OCS)
(cons 11 pt) ;* Second alignment point (in OCS)
(cons 39 0.0) ; Thickness (optional; default = 0)
(cons 40 ht) ;* Text height
(cons 41 0.8) ; Relative X scale factor, Width Factor, defaults to 1.0
(cons 51 0.0) ; Oblique angle
(cons 62 256) ; color
(cons 71 0) ; Text generation flags
(cons 72 0) ; Horizontal text justification type
(cons 73 1) ; Vertical text justification type
(cons 210 (list 0.0 0.0 1.0))
) ))
--- End code ---
HasanCAD:
This is a try
--- Code: ---(defun c:FileHistory (/)
;Get time and date
;Afralisp
(setq d (rtos (getvar "CDATE") 2 6))
(setq yr (substr d 1 4)) ;extract the year
(setq mo (substr d 5 2)) ;extract the month
(setq dy (substr d 7 2)) ;extract the day
(setq hr (substr d 10 2)) ;extract the hour
(setq m (substr d 12 2)) ;extract the minute
(setq Sdate (strcat "Save Date: " (strcat dy "/" mo "/" yr)))
(setq Stime (strcat " Time: " (strcat hr ":" m)))
(setq SUser (strcat " User: " (getvar "loginname")))
(setq SStr (strcat Sdate Stime SUser))
(setq sset (ssget "_X" '((0 . "Text") (1 . "Save Date:*"))))
(setq ss (ssname sset 0))
(setq dxfdata (entget ss))
(setq old-dxf (assoc 10 dxfdata))
(setq y1 (nth 2 old-dxf))
(if (> (sslength sset) 0)
(progn
(repeat (setq inc (sslength sset))
(setq ss (ssname sset (setq inc (1- inc))))
(setq dxfdata (entget ss))
(setq old-dxf (assoc 10 dxfdata))
(setq x (nth 1 old-dxf))
(setq y (nth 2 old-dxf))
(if (> y1 y)
(setq y2 y) ;T
(setq y2 y1) ;not
)
)
(setq Tpt (list x y))
(maketext SStr Tpt 4000)
)
(Progn
(alert (strcat "Pick a point to Insert file history"))
(setq Tpt (getpoint))
(maketext SStr Tpt 4000)
)
)
)
--- End code ---
Coder:
--- Quote from: HasanCAD on May 30, 2012, 04:01:15 am ---
--- Code: ---
(if (???????????)
(progn
(setq Tpt ??????? )
(maketext SStr Tpt 4000)
)
--- End code ---
--- End quote ---
Some missing variables :-D
pBe:
--- Code - Auto/Visual Lisp: ---(defun C:Mark ( / Text Cstr low lowpt strs i e data pts inspt)(vl-load-com) (defun Text (lay pt hgt sty str rot wd) (entmakex (list (cons 0 "TEXT") (cons 1 str) (cons 8 lay) (cons 7 sty) (cons 10 pt) (cons 40 hgt) (cons 41 wd) (cons 1 str))))(setq Cstr (apply 'strcat (mapcar '(lambda (k) (strcat (car k) (menucmd (strcat "m=$(edtime,$(getvar,DATE)," (eval (cadr k)) ")")))) '(("Save Date: " "") ("" "MO/DD/YYYY ") ("Time: " "HH:MMam/pm ") ("User: " (getvar "loginname")))))) (if (setq low nil pts nil strs (ssget "_X" '((0 . "TEXT")(1 . "Save Date:*")))) (progn (repeat (setq i (sslength strs)) (setq e (entget (ssname strs (setq i (1- i))))) (if (or (< (cadr (setq pt (cdr (assoc 10 e)))) low) (null low)) (progn (setq data (append (mapcar 'cdr (vl-remove-if-not '(lambda (k) (vl-position (car k) '(8 40 50 41 7))) e)) (list pt)) low (cadr pt)))) (setq pts (cons pt pts)) ) (setq lowpt (last data)) (setq inspt (list (car lowpt) (- low (if (cadr pts) (apply 'min (mapcar '(lambda (k l) (distance k l)) pts (cdr pts))) 8000)) (last lowpt))) (Text (car data) inspt (cadr data)(nth 4 data) Cstr (caddr data) (nth 3 data)) ) (if (setq inspt (getpoint "\nPick point to insert file history")) (Text (getvar 'Clayer) inspt 4000 (getvar 'Textstyle) Cstr 0.0 1.0) ) )(princ) )
--- Quote from: HasanCAD on May 30, 2012, 04:01:15 am ---Questions:
Q1: How to run this lisp when close the file?
--- End quote ---
I guess the best way to do that is via reactor
HasanCAD:
Thanks pBe
this is mine
--- Code: ---(defun c:FileHistory (/ d yr mo dy hr m
sdate stime suser sstr sset ss dxfdata
dxf y1 old-dxf dxfdata x
y y1 y2
)
(and
;Get time and date
;Afralisp
(setq d (rtos (getvar "CDATE") 2 6))
(setq yr (substr d 1 4)) ;extract the year
(setq mo (substr d 5 2)) ;extract the month
(setq dy (substr d 7 2)) ;extract the day
(setq hr (substr d 10 2)) ;extract the hour
(setq m (substr d 12 2)) ;extract the minute
(setq Sdate (strcat "Save Date: " (strcat dy "/" mo "/" yr)))
(setq Stime (strcat " Time: " (strcat hr ":" m)))
(setq SUser (strcat " User: " (getvar "loginname")))
(setq SStr (strcat Sdate Stime SUser))
(setq ssetL (ssget "_X" '((0 . "Text") (1 . "Save Date:*"))))
(setq sset (if ssetl
(sslength ssetL)
(setq sset 0)
)
)
)
(if (> sset 0)
(progn
(setq ss (ssname ssetL 0))
(setq dxfdata (entget ss))
(setq dxf (assoc 10 dxfdata))
(setq y1 (nth 2 dxf))
)
)
;OK
(if (> sset 0)
(progn
(repeat (setq inc sset)
(setq ss (ssname ssetL (setq inc (1- inc))))
(setq dxfdata1 (entget ss))
(setq old-dxf (assoc 10 dxfdata1))
(setq x (nth 1 old-dxf))
(setq y (nth 2 old-dxf))
(if (> y1 y)
(setq y2 y) ;T
(setq y2 y1) ;not
)
)
(setq Tpt (list x (- y 6000)))
(maketext SStr Tpt 4000)
)
(Progn
(alert (strcat "Pick a point to Insert file history"))
(setq Tpt (getpoint))
(maketext SStr Tpt 4000)
)
)
) ;defun
(defun maketext (str pt ht)
(entmakex (list (cons 0 "TEXT") ;***
(cons 1 str) ;* (the string itself)
(cons 6 "BYLAYER") ; Linetype name
(cons 7 (getvar "TEXTSTYLE"))
;* Text style name, defaults to STANDARD, current
(cons 8 (getvar "CLAYER")) ; layer
(cons 10 pt) ;* First alignment point (in OCS)
(cons 11 pt) ;* Second alignment point (in OCS)
(cons 39 0.0) ; Thickness (optional; default = 0)
(cons 40 ht) ;* Text height
(cons 41 0.8) ; Relative X scale factor, Width Factor, defaults to 1.0
(cons 51 0.0) ; Oblique angle
(cons 62 256) ; color
(cons 71 0) ; Text generation flags
(cons 72 0) ; Horizontal text justification type
(cons 73 1) ; Vertical text justification type
(cons 210 (list 0.0 0.0 1.0))
)
)
)
--- End code ---
Navigation
[0] Message Index
[#] Next page
Go to full version