Code Red > AutoLISP (Vanilla / Visual)

How to run a lisp when close file ?

(1/9) > >>

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