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

guosheyang 发表于 2022-8-6 16:30:09

本帖最后由 guosheyang 于 2022-8-8 14:19 编辑

      给朋友们共享个自定义函数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 发表于 2022-8-6 18:03:41

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

guosheyang 发表于 2022-8-6 19:56:03

本帖最后由 guosheyang 于 2022-8-6 20:02 编辑

baitang36 发表于 2022-8-6 18:03
双击复制主函数全部内容是双击哪里呢？主函数指的是什么？lv不是主函数？没看明白
双击就是在defun 左边的括号处双击就全选函数的内容了如果双击的是主函数就是确定主函数的变量如果双击的是子函数就是子函数的变量了（lv）只是在函数的主函数外比如函数最前面加入的的三个字符用来执行lv函数和jbbl函数，如果局部变量确定完毕代码写好了就不需要这三个字符了

baitang36 发表于 2022-8-6 20:09:42

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

是在vlide中用的？

guosheyang 发表于 2022-8-6 21:12:22

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

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

linhuiu0668 发表于 2022-12-8 17:11:23

是在vlide中编译用的？

我爱lisp 发表于 2023-5-19 12:52:26

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

我爱lisp 发表于 2023-5-19 14:35:09

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

显示“未安装软件”？

我爱lisp 发表于 2023-6-11 22:11:23

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

页: [1]

明经CAD社区's Archiver

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