Extract variables assigned using `setq` into notepad

[Nikon]

Is it possible to extract variables assigned using `setq` into notepad using lisp?
For example, for this part of the code
(setq firstY (cadr first))
(setq seconY (cadr second))
(setq my_line (car (entsel " Klik pline ")))
(setq spis_line (entget my_line))
(setq spis_ln nil)
Receive:
firstY seconY my_line spis_line

¿¿`extract-setq-variables` ??

[Steven P]

Yes, there are plenty of examples out there to write to a notepad file, use the write-line code and the value.

 

Can't remember just now if the value has to be a string (RTOS) but you can find that out easy enough, and of course you can use something like (strcat ) to concatenate strings and variables together into a single line.

 

A common example of this might be creating a DCL 'on the fly' where it creates a temporary text file and that can be used.

 

Once you have created the text file you will want to open it using something like (startapp "c:/windows/notepad.exe" 'filename')

[Nikon]

54 minutes ago, Steven P said:

Yes, there are plenty of examples out there to write to a notepad file, use the write-line code and the value.

Can't remember just now if the value has to be a string (RTOS) but you can find that out easy enough, and of course you can use something like (strcat ) to concatenate strings and variables together into a single line.

A common example of this might be creating a DCL 'on the fly' where it creates a temporary text file and that can be used.

Once you have created the text file you will want to open it using something like (startapp "c:/windows/notepad.exe" 'filename')

The lisp file is located in the Support folder, for example.
Is it possible for the user to enter the name of the program and get a list of local variables from the specified program?

??? 
(defun extract-setq-variables (code)
  (let ((variables '()))
    (dolist (form code)
      (when (and (listp form) (eq (car form) 'setq))
        (dolist (var (cdr form))
          (when (symbolp var)
            (push var variables)))))
    (nreverse variables))) 
???
 

[Steven P]

This isn't 100% bug free:

srchlsp

 

About 350 lines, can probably be done a bit better

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:ListVariables ( / MyFile) ; ready for batch
  (setq MyFile (getfiled "Select LISP File to Query" (getmyfolder) "lsp" 16))
  (srchlsp MyFile )
  (princ)
)
(defun c:srchlsp ( / MyFile) ; ready for batch
  (setq MyFile (getfiled "Select LISP File to Query" (getmyfolder) "lsp" 16))
  (srchlsp MyFile )
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun lstprts ( MyList StartDel EndDel startpos / result acount acounter NewLst pos) ;; Make list from lines
  (setq NewLst (list))
  (setq acounter 0)
  (setq acount startpos)

  (while (< acount (length MyList))
    (if (= (nth acount MyList) StartDel)
      (setq acounter (+ acounter 1))
    )
    (if (= (nth acount MyList) EndDel)
      (setq acounter (+ acounter -1))
    )

    (setq acount (+ acount 1))
    (if (= acounter 0)
      (progn
        (setq pos acount)
        (setq acount (length MyList))
      )
      (progn
        (setq NewLst (append NewLst (list (nth acount MyList))))
      )
    )
  ) ; end while

  (setq result (list pos (append (list StartDel) NewLst)))
  result

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun splitlst ( MyList StartDel EndDel / result acount lst aresult x y z) ;; split into main functions
  (setq result (list))
  (setq acount 0)
  (while (< acount (length MyList)) ; split up main functions
    (setq lst (lstprts MyList StartDel EndDel acount))
    (setq result (append result (list (nth 1 lst))))
    (setq acount (nth 0 lst))
  ) ; end while

  (setq MyList (list))
  (foreach x result
    (setq aresult (splitsublist x StartDel EndDel))
    (foreach y aresult
      (setq z (vl-string-left-trim "0123456789 " y))
      (setq MyList (append MyList (list z)))
    )
  ) ; end foreach
  MyList
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun splitsublist ( MyList StartDel EndDel / StartCounter SplitList SplitListLength defcounterlist maxdefcount totaldefuns defuncount acount) ; split sub functions
  (setq StartCounter 0)
  (setq SplitList (list))
  (setq SplitListLength 0)
  (setq defcounterlist (list 0))
  (setq maxdefcount 0)
  (setq totaldefuns (- (length MyList) (length (vl-remove StartDel MyList))))

  (if ( = totaldefuns 1)
    (progn
      (setq MyList (LM:Unique MyList)) ; unique values only
      (setq SplitList (list (strcat "0 " (LM:lst->str MyList " ") )))
    )
    (progn
      (setq defuncount -1)
      (setq acount 0)
      (while (< acount totaldefuns) ; create blank list, SplitList
        (setq SplitList (append SplitList (list (rtos acount) )))
        (setq acount (+ acount 1))
      )
      (foreach x MyList
        (if (= x StartDel)
          (progn
            (setq maxdefcount (+ maxdefcount 1))
            (setq defcounterlist (append defcounterlist (list maxdefcount)))
          ) ; end progn
        ) ; go up 1
        (setq defuncount (- (last defcounterlist) 1) )
        (setq SplitList (subst (strcat (nth defuncount SplitList) " " x) (nth defuncount SplitList) SplitList))
        (if (= x EndDel)(setq defcounterlist (reverse (cdr (reverse defcounterlist)))) ) ; go down 1 defuncounter
      ) ; end foreach
      (setq asplitlist (list))
      (foreach x SplitList
        (setq SplitList (subst (LM:lst->str (LM:Unique (LM:str->lst x " ")) " ") x SplitList)) ; unique values
      )
    ) ; end prgn
  ) ; end if

  SplitList
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun LM:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
)
(defun LM:lst->str ( lst del / )
    (if (cdr lst)
        (strcat (car lst) del (LM:lst->str (cdr lst) del))
        (car lst)
    )
)
(defun LM:Unique ( l / )
    (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
)
(defun LM:StringSubst ( new old str / inc len )
    (setq len (strlen new)
          inc 0
    )
    (while (setq inc (vl-string-search old str inc))
        (setq str (vl-string-subst new old str inc)
              inc (+ inc len)
        )
    )
    str
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun removequotes ( line / splittext acount)
  (setq splittext (LM:str->lst line (chr 34))) ; ignore "

  (setq acount 0)
  (setq line "")
  (while ( < acount (length splittext))
    (setq line (strcat line (nth acount splittext)))
    (setq acount (+ acount 2))
    (if (= acount (length splittext))(setq line (strcat line (last splittext)))) ; a bad fix
  ) ; end while
  line
) ; end defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun countbracketO ( line / splittext)
  (setq line (removequotes line))
  (setq splittext (LM:str->lst line (chr 40)))
  (- (length splittext) 1)
) ; end defun

(defun countbracketC ( line / splittext)
  (setq line (removequotes line))
  (setq splittext (LM:str->lst line (chr 41)))
  (- (length splittext) 1)
) ; end defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun MakeClipBoardText ( MyText / htmlfile )
  (vlax-invoke (vlax-get (vlax-get (setq htmlfile (vlax-create-object "htmlfile")) 'ParentWindow) 'ClipBoardData) 'setData "Text" Mytext)
  (vlax-release-object htmlfile)
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun WriteListToFile ( AList / fn Lispfile LFDES x MyString)
  (setq fn "srchlsp.txt")
  (if (strcat (getvar "TEMPPREFIX") fn)(vl-file-delete (strcat (getvar "TEMPPREFIX") fn)))
  (setq Lispfile (strcat (getvar "TEMPPREFIX") fn))
  (setq LFDES (open Lispfile "w"))
  (foreach x AList
    (setq MyString (vl-string-trim "EndDefun" x))
    (write-line MyString LFDES)
  )
  (setq LFDES (close LFDES))
  (if (findfile Lispfile) (startapp "notepad" Lispfile))
  (if (not (findfile Lispfile)) (princ "\nError writing file"))
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;returns the next word(s) in a text string after the search term(s)
(defun NextWord ( s p / l result lcount pcount MyString x y)
  (defun xyz123 ( p l lcount / MyString pcount x )
    (setq MyString nil)
    (setq pcount 0)
    (while (< pcount (length p))
      (if (setq x (vl-string-search (strcase (nth pcount p)) (strcase (nth lcount l)))) ; if in text strng,
        (progn
          (setq MyString (strcat (nth pcount p) " " (nth (+ lcount 1) l)))
          (setq pcount (+ pcount 1))
        )
        (progn
          (setq pcount (+ pcount 1))
        ) ; end progn
      ) ; end if
    ) ; end while
    MyString
  ) ; end defun

  (setq l (LM:str->lst s " ") ) ; make line into list
  (setq result (list))
  (setq y 0)
  (setq pcount 0)

  (while (< pcount (length p) ) ; check line for search terms
    (setq x (vl-string-search (strcase (nth pcount p)) (strcase s)))
    (if (= x nil)()(setq y (+ y 1)))
    (setq pcount (+ pcount 1))
  ) ; end while

  (if (> y 0) ; do for applicable lines
    (progn
      (setq lcount 0)
      (while (< (+ lcount 1) (length l))
        (setq MyString (xyz123 p l lcount))
        (if (= MyString nil)
          ()
          (setq result (append result (LM:str->lst MyString " ") ))
        )
        (setq lcount (+ lcount 1))
      ) ; end while
    ) ; end if
  ) ; end progn
  result
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun srchlsp ( file / *error* searchlist EndDelim Nesteddefuns TxtLst f CTO CTC CT Line FoundText MyCount TempList LstTxt x)
  (defun *error* ( msg / MyError )
    (setq MyError 1)
    (if (and file (eq 'FILE (type file))) (close file))
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
      (princ (strcat "\n** Error: " msg " **")))
    (princ)
  )
  (defun stringsub ( MyString newterm oldterm / )
    (setq strsrch (vl-string-search oldterm MyString))
    (while (/= strsrch nil)
      (setq MyString (vl-string-subst newterm oldterm MyString) )
      (setq strsrch (vl-string-search oldterm MyString))
    )
    MyString
  )

  (setq alerttext "This will produce a temporary text file showing:")
  (setq alerttext (strcat alerttext "\nFunction names variables used in that function."))
  (setq alerttext (strcat alerttext "\n\nResults Explained"))
  (setq alerttext (strcat alerttext "\n'(' Blank line indicates a 1 line function (unnamed in this listing)"))
  (setq alerttext (strcat alerttext "\nVariables will only be found if coded \"(strcat xyz....\""))
  (setq alerttext (strcat alerttext "\nThe whole lot failes if brackets are out of order or other similar things"))
  (alert alerttext)

  (setq searchlist (list (strcat "(defun")(strcat "(setq")(strcat "(foreach") ))
  (setq enddelim "EndDefun")
  (setq nesteddefuns (list))
  (setq TxtLst (list) )
  (setq ctO 0)(setq ctC 0)(setq ct 0) ;; reset bracket counters
  (setq linelist (list))

  (princ "Searching for: ")(princ searchlist)(princ "\n")

  (setq LineCount 0)
  (if (setq f (open file "r"))
    (progn
      (while (setq line (read-line f))
        (setq line (stringsub line "" (strcat (chr 92)(chr 92)))) ; remove \\
        (setq line (stringsub line "" (strcat (chr 92)(chr 34)))) ; remove \"
        (setq line (removequotes line))            ;; remove quotes '"'
        (setq line (nth 0 (LM:str->lst line ";"))) ;; Remove Comments ';'
        (if (or (= line nil) (= line "") )   ;; ignore commented out lines, blank lines
          ()
          (progn
            (setq ctO (countbracketO line))            ;; count opening brackets
            (setq ctC (countbracketC line))            ;; count closing brackets
            (setq ct (+ ct (- ctO ctC)))               ;; sum brackets
            (if (= (wcmatch (strcase line) (strcase (strcat "*" (nth 0 searchlist) "*"))) nil) ;;assuming only 1 defun per line
              ()
              (if (= ctO ctC)
                (setq nesteddefuns (append (list ct) nesteddefuns))       ; single line function
                (if (= ctC 0)
                  (progn
                    (while (/= ctO (+ ctC 1))
                      (setq lineb (read-line f))
                      (setq lineb (LM:StringSubst "" (strcat (chr 92)(chr 34)) lineb))
                      (setq lineb (removequotes lineb))            ;; remove quotes '"'
                      (setq lineb (nth 0 (LM:str->lst lineb ";"))) ;; Remove Comments ';'
                      (if (or (= lineb nil) (= lineb "") )   ;; ignore commented out lines, blank lines
                        ()
                        (progn
                          (setq line (strcat line lineb))
                          (setq ctO (countbracketO line))            ;; count opening brackets
                          (setq ctC (countbracketC line))            ;; count closing brackets
                          (setq ct (+ ct (- ctO ctC)))               ;; sum brackets
                        ) ; end progn
                      ) ; end if
                    ) ; end while
                    (setq nesteddefuns (append (list (- ct 1)) nesteddefuns)) ; multiline function
                  ) ; end progn
                  (progn
                    (setq nesteddefuns (append (list (- ct 1)) nesteddefuns)) ; multiline function
                  ) ; end progn
                ) ; end if
              ) ; end if
            ) ; end if

            (if (= ct (car nesteddefuns)) ;; if ct value is the same as the list
              (progn
                (setq linelist (append linelist (list enddelim)))
                (setq nesteddefuns (cdr nesteddefuns))
              ) ; end progn
            ) ; end if

;;;add in search expressions
            (if (and
                  (foreach x seachlist
                    (= (wcmatch (strcase line) (strcase (strcat "*" x "*"))) nil)
                  )
                )
              ()
              (setq linelist (append linelist (NextWord line searchlist)))
            ) ; end if
          ) ; end progn
        ) ; end if 'non blank lines'

      ) ; end while
      (close f)
    ) ; end progn
  ) ; end if

  (setq lsttxt (splitlst linelist (nth 0 searchlist) enddelim))
;Display in command line
  (foreach x lsttxt
    (princ "\n")
    (princ (type x))
    (princ x)
  )

  (WriteListToFile lsttxt)
;;  (MakeClipBoardText (LM:lst->str lsttxt " "))
  (princ)
)

 

[GLAVCVS]

It is difficult to get variables declared in a lisp by just reading the file.
Because it often happens that a variable is declared without having 'setq' in front of it.
I think the safest way is to call 'atoms-family', execute the code in your file and then call 'atoms-family' again. The difference between the list returned by the first call and the second is the list you need.

[GLAVCVS]

Although it is possible that there are parts of the code that are not executed and those variables are not declared. Therefore, I recognize that it is not the perfect solution either.

[Nikon]

1 hour ago, Steven P said:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:ListVariables ( / MyFile) ; ready for batch
 (setq MyFile (getfiled "Select LISP File to Query" (getmyfolder) "lsp" 16))
 (srchlsp MyFile )
 (princ)
)

ListVariables

; error: no function definition: GETMYFOLDER

 

 

[Steven P]

Should be this one:

 

 

(defun GetMyFolder( / MILFO)
  (defun GetDesktop ( / script spFolders desktop)
    (cond (
      (setq script (vlax-create-object "WScript.Shell"))
      (setq spFolders (vlax-get-property script "SpecialFolders")
            desktop   (vlax-invoke-method spFolders 'Item "Desktop")
      )
      (vlax-release-object spFolders)
      (vlax-release-object script)
      )
    )
    desktop
  )

;;  (setq MILFO (strcat (getdesktop) "\\AutoCAD\\AutoCAD LISPS\\")) ;; your LISP file path, though it doesn't matter too much. Use this line to go from Desktop
  (setq MILFO "c:\\")
  MILFO
)

 

 

[Steven P]

1 hour ago, GLAVCVS said:

It is difficult to get variables declared in a lisp by just reading the file.
Because it often happens that a variable is declared without having 'setq' in front of it.
I think the safest way is to call 'atoms-family', execute the code in your file and then call 'atoms-family' again. The difference between the list returned by the first call and the second is the list you need.

 

Yes, there isn't a perfect solution that I have found:

(setq in the code will hint at the variable used but if the code is

(setq a ....

          b ...

          c ...)

it will only pick up a, not b, c

 

atoms-family... unless the variable has been used previously, a global variable perhaps... which I think is the OPs intention to localise variables, though a new drawing where you only run the LISP in question should get most (except in auto-run LISPs). However in that any branches in the code - if statements - will only record the variables used in the particular branch selected, you'd need to run the code a few times to capture each possibility.

 

Could try something like notepad++ where variables are highlighted, though that takes some discipline to record which variables are used.... good habits arn't bad thing

 

[Nikon]

1 hour ago, Steven P said:

Should be this one:

 

 

(defun GetMyFolder( / MILFO)

Thanks! With the "Get My Folder" function, a list of variables is created in notepad, but not all of them.

I will also test different codes.

[GLAVCVS]

It's interesting
Maybe the solution is to mix the 2 approaches:
call 'atoms-family' at the beginning and start a loop
in which the code tries to identify each expression in the file, evaluates it (creating the arguments that are necessary) and calls 'atoms-family' to check if any new symbol has been created. And, in this way, repeat the loop as many times as expressions the code detects.

It's a good task

[Steven P]

4 hours ago, Nikon said:

Thanks! With the "Get My Folder" function, a list of variables is created in notepad, but not all of them.

I will also test different codes.

 

It won't get all of them, only the ones preceded with (setq but it is a start