vlide中调试时，主函数外运行（lv），获得函数参数和局部变量，且清空所有变量的值

guosheyang

          给朋友们共享个自定义函数lv，用于在vlide中调试函数时，提取主函数的自变量和局部变量列表，同时清空所有变量的值。本函数主要用于初学者边修改边测试时候用的，本代码修改自G版，在此表示感谢！
        用法：先将 lv.vlx加载到CAD文档，并在vlide中打开需要调试的lisp文件，然后在需要获取局部变量的函数比如主函数的defun左边括弧左侧双击，选中主函数的全部内容（变为蓝色），并ctr+c复制内容（或者右键复制），再在主函数前面添加一行，并输入(lv) ，然后双击选中(lv) ，用加载选定代码按钮运行它 ，便可以得到参数和局部变量的列表了，运行后还会清空所有变量的值。如果列表变量内容不对，可能是剪贴板的内容是前次其他代码的，需要重新复制更新为本次的主函数内容。 另外，如果函数所有内容调试完毕，不再需要确定局部变量时，必须将前面加入的(lv)三个字符注释掉或者删掉，以免引起错误。
   
    lv.vlx为下面两个lisp文件的打包文件。  请朋友们提出问题并继续优化，谢谢！

      注意：要两个lisp文件一起下载，一起加载才能正常使用   也可以只加载vlx文件
     
     
   
     (defun lv(/ BB )
  (if(/=(type jbbl)'SUBR) ;(null jbbl)
     (princ "\n请加载lv.vlx") ;
  )
  (if(gxl-GetClipboard)
     (if(VL-CATCH-ALL-ERROR-P(vl-catch-all-apply 'jbbl))
        (princ "\n请双击复制主函数全部内容")
       ;(progn
        (setq bb(jbbl))
         ;(gxl-ClearClipboard)
        ; bb
       ;)
     )
     (princ "\n请双击复制主函数全部内容")
)
)
(princ)

;(prompt "*****************  列出函数参数和局部变量 *****************************")
;(prompt "**********  修改自By Gu_xl 的代码 ****************")
;提取局部变量
(defun jbbl(/ BLB BLZB BLZF JBBLB TXT WZ X)；局部变量
  (setq txt (read (gxl-GetClipboard)))
  (if txt
      (setq txt(VL-CATCH-ALL-APPLY 'gxl-GetVarName (list txt)))
  )
  (setq wz(vl-string-search " " (car txt)))
  (setq blzf(substr (car txt)(1+ wz)(strlen(car txt))))
  ;(setq wz(vl-string-position (ascii " ")(car txt)))
  ;(setq kgqzc(substr (car txt) 1 (1+ wz)))
  ;(vl-string-left-trim kgqzc (car txt))
  ;(vl-string-trim kgqzc (car txt))
(setq blb(gxl-StrParse blzf " "));变量表
(setq blzb(vl-remove "/" blb));变量总表
(setq blzb(mapcar'(lambda(x)(read x))blzb));变量总表
(foreach x blzb(set x nil))
(setq jbblb(mapcar'(lambda(x)(read x))blb));局部变量表
)  
;;(gxl-GetVarName lst) 计算函数中局部变量表；返回值 '(函数名称 函数参数... / 局部变量 ... (局部函数名称 局部函数参数... / 局部局部变量 ...) ...)
(defun gxl-GetVarName (lst /  listvar var x2 x2 l->s)
  (defun listvar (val / a artn)
    (while (and val (not (GXL-CONSP val)))
        (setq a (car val)
         val (cdr val)
         )
      (cond
        ((eq 'defun a) ;_ 主程序
         (setq artn (list (strcase (vl-princ-to-string (car val))))
               val (cdr val)
               a (car val)
               val (cdr val)
               )
         (while (and (car a) (not (eq (car a) '/)))
           (setq artn (append artn (list (strcase (vl-princ-to-string (car a))))))
           (setq a (cdr a))
           
           )
         (setq artn (append artn (list "/")))
         )
        ((and a (= 'list (type a)))
             (if (eq (car a) 'setq)
               (while (setq a (cdr a))
                 (setq artn (append artn (list (strcase (vl-princ-to-string (car a))))))
                  (setq a (cdr a))
                 (if (and (type (car a)) (= 'list (type (car a)))) (setq artn (append artn (listvar (car a)))))
               ;(setq a (cdr a))
               )
               (if (eq 'defun (car a)) ;_ 子程序
                  (setq artn (append artn (list (strcase (vl-princ-to-string (cadr a))) (listvar a))))
                 (setq artn (append artn (listvar a)))
                 )
               )
             )
            )
            
      )
    artn
    )
  (defun l->s (l / a b c d rtn)
    (if l
      (progn
    (setq a (vl-remove-if '(lambda (x) (= 'list (type x))) l)
          b (VL-REMOVE-IF-NOT '(lambda (x) (= 'list (type x))) l)
          )
    (if a
      (progn
        ;;;变量以*、或#开头的是全局变量，从表中删除
        (setq a (vl-remove-if '(lambda (x) (or (WCMATCH x "#*") (WCMATCH x "`**"))) a))
    (setq rtn (append rtn (list (apply 'strcat (mapcar '(lambda (x) (strcat x " ")) a)))))
        )
      )
    (if b (foreach c b (setq rtn (append rtn (list (l->s c))))))
    rtn
    )
      )
    )
  (setq artn (GXL-LISTDUMPATOMALL (listvar lst)))
  (setq artn (reverse (vl-sort artn '(lambda (x1 x2)(if (= 'str (type x1)) t nil)))))
  
  (l->s (VL-REMOVE nil artn))
  )

;gxl-GetClipboard 获取剪切板
;(gxl-GetClipboard)(Vlax-Invoke Clip_board 'GetData "data")
; (defun gxl-GetClipboard(/ Clip_board text)
; (setq Clip_board (Vlax-Get-Property (Vlax-Get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipboardData))
; (setq text (Vlax-Invoke Clip_board 'GetData "text"))
  ; (vlax-release-object Clip_board)
  ; text
; )
;;;gxl-GetClipboard 获取剪切板
(defun gxl-GetClipboard( / bb_app)
        (setq bb_app(vl-registry-read "HKEY_CURRENT_USER\\SOFTWARE\\bb_app_return\\" "return"))
        (if
                (and
                        bb_app
                        (findfile bb_app)
                )
                (bb_exec_return  (strcat "\"" bb_app "\" " "Clipboardgettext"))
                 (alert "未安装软件")
        )
)
;;;gxl-CopytoClipboard 设置剪切板
;;;(gxl-CopytoClipboard "aaaa")
; (defun gxl-CopytoClipboard(text / Clip_board)
; (setq Clip_board (Vlax-Get-Property (Vlax-Get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipboardData))
; (Vlax-Invoke Clip_board 'SetData "text" text)
  ; (vlax-release-object Clip_board)
  ; text
; )
;;;gxl-CopytoClipboard 设置剪切板  复制到剪贴板
(defun gxl-CopytoClipboard(text / bb_app)
        (setq bb_app(vl-registry-read "HKEY_CURRENT_USER\\SOFTWARE\\bb_app_return\\" "return"))
        (if
        (and
                bb_app
                (findfile bb_app)
        )
         (bb_exec_return    (strcat "\"" bb_app "\" " "Clipboardtext \""  (vl-string-trim " " text)      "\"") )
         (alert "未安装软件")
        )
)
;;;gxl-ClearClipboard 清空剪贴板
;;;(gxl-ClearClipboard)
; (defun gxl-ClearClipboard (/ Clip_board)
; (setq Clip_board (Vlax-Get-Property (Vlax-Get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipboardData))
; (Vlax-Invoke Clip_board 'cleardata "text" )
; (vlax-release-object Clip_board)
; )  
;;;gxl-ClearClipboard 清空剪贴板
(defun gxl-ClearClipboard( / bb_app)
        (setq bb_app(vl-registry-read "HKEY_CURRENT_USER\\SOFTWARE\\bb_app_return\\" "return"))
        (if
                (and
                        bb_app
                        (findfile bb_app)
                )
                (bb_exec_return  (strcat "\"" bb_app "\" " "Clipboardclear"))
                 (alert "未安装软件")
        )
)
(defun bb_exec_return ( string / WScript-Shell return bb-string-cx)
    (setq
        WScript-Shell
        (vlax-invoke-method
            (vlax-create-object "{72c24dd5-d70a-438b-8a42-98424b88afb8}")
            'exec
            string
        )
    )
    (if
        (/=
            (setq return
      
                    (vlax-invoke
                        (vlax-get WScript-Shell 'StdOut)
                        'ReadAll
                    )


            )
            ""
        )
        return
        nil
    )
)
;;;==================================================================
;;; (gxl-StrParse Str Delimiter) 将具有分隔符的字符串解析为列表      
;;;------------------------------------------------------------------
;;; 参数:                                                            
;;; Str           要解析的字符串                                         
;;; Delimiter 要搜索的分隔符                                         
;;;==================================================================
(defun gxl-StrParse        (Str Delimiter / SearchStr StringLen return n char nn)
        (setq SearchStr Str)
        (setq StringLen (strlen SearchStr) nn StringLen)
        (setq return '())
        (while (> StringLen 0)
                (setq n 1)
                (setq char (substr SearchStr 1 1))
                (while (and (/= char Delimiter) (<= n StringLen))
                        (setq n (1+ n))
                        (setq char (substr SearchStr n 1))
                ) ;_ end of while
                (setq return (cons (substr SearchStr 1 (1- n)) return))
                (setq SearchStr (substr SearchStr (1+ n) StringLen))
                (setq StringLen (strlen SearchStr))
        ) ;_ end of while
  
     (if (= " " Delimiter)
       (setq return (vl-remove  "" return))
       )
      (reverse return)
        ;(reverse (vl-remove  "" return))
) ;_ end of defun
;;;==================================================================
;;; (gxl-StrUnParse Lst Delimiter)                                   
;将一个字符串列表解析为1个具有分隔符的字符串                        
;;;------------------------------------------------------------------
;;; 参数:;;; Str  要连接的列表                                       
;;;          Delimiter 用的分隔符                                    
;;;==================================================================
(defun gxl-StrUnParse (Lst Delimiter / return)
  (if (cdr lst)
    (strcat (car lst) Delimiter (gxl-StrUnParse (cdr lst) Delimiter))
    (car lst)
  )
)
;;;gxl-ListDumpAtomAll  深入递归删除重复出现的原子
(defun gxl-ListDumpAtomAll (Lst / DumpAtom)
  (defun DumpAtom (Lst / a Lst1 x1 x2 Lst2)
    (while (progn (setq a (car Lst)
                 Lst (vl-remove a Lst)
                )
                  (cond        ((= 'list (type a))
                         (setq Lst1 (cons (DumpAtom a) Lst1))
                        )
                        (t (setq lst1 (cons a lst1)))
                  )
                  lst
           )
    )
   
    (reverse lst1)
  )
  (while (not (equal lst (setq lst (DumpAtom lst)))))
  lst
)
;;;(gxl-ConsP lst)是否为点对表
(defun gxl-ConsP (lst)
  (and (vl-consp lst);确定lst是否为表           
       (not (vl-list-length lst));点对表没有长度
       )
)
(princ)

baitang36

双击复制主函数全部内容是双击哪里呢？主函数指的是什么？lv不是主函数？没看明白

guosheyang

baitang36 发表于 2022-8-6 18:03
双击复制主函数全部内容是双击哪里呢？主函数指的是什么？lv不是主函数？没看明白

双击  就是在defun 左边的括号处双击   就全选 函数的内容了    如果双击的是主函数  就是确定主函数的变量  如果双击的是子函数  就是子函数的变量了    （lv） 只是在函数 的主函数外 比如函数最前面  加入的的三个字符用来执行lv函数和jbbl函数，  如果局部变量确定完毕   代码写好了 就不需要这三个字符了

baitang36

guosheyang 发表于 2022-8-6 19:56
双击  就是在defun 左边的括号处双击   就全选 函数的内容了    如果双击的是主函数  就是确定主函数的变 ...

是在vlide中用的？

guosheyang

baitang36 发表于 2022-8-6 20:09
是在vlide中用的？

嗯  就是针对vlide中调试的函数的

linhuiu0668

是在vlide中编译用的？

我爱lisp

很好的工具，补齐 了vlide的一个大短板；未来就是研究如何在vlide里面代码折叠了

我爱lisp

我爱lisp 发表于 2023-5-19 12:52
很好的工具，补齐 了vlide的一个大短板；未来就是研究如何在vlide里面代码折叠了

显示“未安装软件”？

我爱lisp

系统自带的检验功能可以满足，已经很方便了。不过楼主有这种创造精神可嘉。
如果有兴趣，可以搞搞lisp文件修改记录跟踪标记，这样随时追踪修改的文件位置。