SSF升级版支持vlsfasvlx格式文件指定路径内模糊搜

本帖最后由寒潮大冬瓜于 2026-3-8 16:08 编辑

SSF指定路径内模糊搜索代码使用功能等按文件名代码搜索并运行命令(带对话框)界面伸缩89
好多下载的或者自己拼凑的lsp代码，放在一个文件夹里，通过外置“自动加载文件夹中的lsp-fas-vlx-VLS文件.lsp”代码进行加载。由于功能较多记忆模糊，很难完全记住不常用的功能的命令，于是ssf代码来了→支持模糊搜索，点取后能自动提取文件前命令→开始停止ssf代码→开始运行确定的命令！也就不担心代码太多的问题了，于是代码文件名很长就知道是为什么了→便于检索！
喜欢的更换代码里的文件路径就能用了！
;; ------------------------------------------------------------
  ;; 主程序开始
  ;; ------------------------------------------------------------
  (princ "\nSSF：按文件代码搜索并运行命令（文件夹：C:\\XCAD\\0JIAZAI）")

  ;; 初始化文件列表
  (setq files-list (scan-files "C:\\XCAD\\0JIAZAI"))

2026年03月07日17时37分22秒升级版：SSF升级版支持vlsfasvlx格式文件指定路径内含子文件夹模糊搜索代码使用功能等按文件名代码搜索并运行命令(带对话框)
;;; 功能：扫描"C:\XCAD\0JIAZAI"文件夹下的所有LSP/FAS/VLX/VLS文件，代码实际上不常用的代码可以考虑不需要用“自动加载文件夹中的lsp-fas-vlx-VLS文件.lsp”提前加载，那么就用“自动加载文件夹中的lsp-fas-vlx-VLS文件.lsp”加载子文件夹内的代码文件，用ssf管理需要的时候再加载并运行的代码文件。
与加载代码配合使用相得益彰！
自动加载文件夹中的lsp-fas-vlx-VLS文件(不支持子文件夹内文件加载→配合ssf代码)
https://bbs.mjtd.com/forum.php?mod=viewthread&tid=194653&fromuid=418631
(出处: 明经CAD社区)

使用攻略：用不包含子文件夹的加载lsp+支持子文件夹的ssf→完美实现→cad开启时→只加载常用几个插件→想起要用哪个插件或代码→再用模糊搜索的ssf代码→输入关键词A*关键词B*关键词C→点搜索或刷新→直到对话框面板出现自己心仪的代码→点中→确定→自动加载+运行提取的快捷命令(格式是非中文字符，否者ssf无法帮你提取快捷键命令)→丝滑助力cad绘图！

网友答: 写过一个，给楼主参考

网友答:

寒潮大冬瓜发表于 2026-3-7 10:41
建议大侠分享给大家

那我就献丑啦
啾...嘣...

(defun c:slsp (/ *error* str key flst fi dm ln fn rf r1 gn e1 catch s)
(defun *error* (s)
(princ (strcat "\n错误停留文件: " fn))
(princ (strcat "\n错误对应行: " (itoa ln)))
(if (/= s "函数被取消")
(vl-bt)
)
(if rf
(close rf)
)
(princ)
)
;; 获取搜索字符串
(if (and (boundp 'ostr) ostr)
(princ (strcat "\n要查找的代码段: <" ostr ">"))
(princ "\n要查找的代码段:")
)
(setq str (getstring t))
;; 获取搜索选项
(initget "Yes No")
(setq key (getkword "\n忽略大小写[是(Y)/否(N)] <Y>:"))
(if (or (null key) (= key "Yes"))
(setq key "Yes")
)
;; 更新或使用上次的搜索字符串
(if (/= str "")
(setq ostr str)
(if (boundp 'ostr)
(setq str ostr)
(progn
(princ "\n必须输入搜索字符串!")
(exit)
)
)
)
;; 设置搜索路径
(setq mp2 (mypath 2))
(setq mp1 (mypath 1))
(setq flst
(apply 'append
(mapcar '(lambda (a)
(mapcar '(lambda (x) (strcat a "\\" x))
(vl-directory-files a "*.lsp" 1)
)
)
(list
(strcat mp2 "L2F")
(strcat mp2 "L2F\\加载程序")
(strcat mp2 "L2F\\机械图框\\MECpg")
(strcat mp2 "PsAddLsp")
(strcat mp2 "DxmlPlus")
(strcat mp1 "cao.y\\加载程序")
(strcat mp1 "\\MyCAD\\加载程序")
)
)
)
)
;; 搜索文件
(setq fi 0)
(setq dm t) ; 标记是否找到任何匹配
(princ "\n以下文件包含代码段:")
(foreach fn flst
(setq ln 0)
(setq rf (open fn "r"))
(setq r1 (read-line rf))
(setq gn 0) ; 当前文件的匹配计数
(while r1
(setq ln (1+ ln))
;; 检查是否匹配
(setq e1
(if (= key "Yes")
(wcmatch (strcase r1) (strcat "*" (strcase str) "*"))
(wcmatch r1 (strcat "*" str "*"))
)
)
(if e1
(progn
(setq dm nil) ; 至少找到一个匹配
;; 第一次匹配时显示文件名
(if (= gn 0)
(progn
(princ (strcat "\n\n文件名: " fn))
(princ "\n匹配行:")
)
)
(setq gn (1+ gn))
;; 尝试获取更精确的匹配上下文
(setq catch (gocatch
'(execute
r1
(strcat ".{0,10}" str ".{0,10}")
nil
nil
)
))
(if (car catch)
;; 错误处理
(progn
(princ (strcat "\n错误停留文件: " fn))
(princ (strcat "\n错误对应行: " (itoa ln)))
(princ "\n读取错误内容: ")
(princ r1)
(vl-bt)
)
;; 正常显示匹配
(progn
(princ (strcat "\n 行 " (itoa ln) ": "))
(if (and (cadr catch) (car (cadr catch)))
(princ (car (cadr catch)))
(princ r1)
)
)
)
)
)
(setq r1 (read-line rf))
)
(close rf)
)
(if dm
(princ "\n没有找到代码段!")
)
(princ)
)
;;1 我的文档 2 桌面 3其余当前文件夹
(defun mypath (num / wss spe desktop)
(setq wss (vlax-create-object "WScript.Shell"))
(setq spe (vlax-get-property wss "SpecialFolders"))
(setq Desktop (vlax-invoke-method spe "Item" "Desktop"))
(cond
((= num 1) (strcat (getvar "mydocumentsprefix") "\\"))
((= num 2) (strcat Desktop "\\"))
(t (getvar "DwgPrefix"))
)
)
;; 辅助函数保持不变
(defun gocatch (func / s e)
(setq s (vl-catch-all-error-p
(vl-catch-all-apply
'(lambda () (setq e (eval func)))
)
)
)
(list s e)
)
(defun execute (str ex gm ic / r s lst a)
(setq r (vlax-create-object "vbscript.regexp"))
(if gm
(progn
(vlax-put-property r 'global -1)
(vlax-put-property r 'Multiline -1)
)
)
(if ic
(vlax-put-property r 'ignorecase -1)
)
(vlax-put-property r 'pattern ex)
(setq s (vlax-invoke r 'execute str))
(vlax-release-object r)
(vlax-for x s
(setq a (vlax-get-property x 'value))
(setq lst (cons a lst))
)
(reverse lst)
)

(defun c:slsp (/ *error* str key flst fi dm ln fn rf r1 gn e1 catch s) 
  (defun *error* (s) 
    (princ (strcat "\n错误停留文件: " fn)) 
    (princ (strcat "\n错误对应行: " (itoa ln))) 
    (if (/= s "函数被取消") 
      (vl-bt) 
    ) 
    (if rf 
      (close rf) 
    ) 
    (princ) 
  ) 
   
  ;; 获取搜索字符串 
  (if (and (boundp 'ostr) ostr) 
    (princ (strcat "\n要查找的代码段: <" ostr ">")) 
    (princ "\n要查找的代码段:") 
  ) 
  (setq str (getstring t)) 
   
  ;; 获取搜索选项 
  (initget "Yes No") 
  (setq key (getkword "\n忽略大小写[是(Y)/否(N)] <Y>:")) 
  (if (or (null key) (= key "Yes")) 
    (setq key "Yes") 
  ) 
   
  ;; 更新或使用上次的搜索字符串 
  (if (/= str "") 
    (setq ostr str) 
    (if (boundp 'ostr) 
      (setq str ostr) 
      (progn 
        (princ "\n必须输入搜索字符串!") 
        (exit) 
      ) 
    ) 
  ) 
   
  ;; 设置搜索路径 
  (setq mp2 (mypath 2)) 
  (setq mp1 (mypath 1)) 
  (setq flst 
    (apply 'append 
      (mapcar '(lambda (a) 
                (mapcar '(lambda (x) (strcat a "\\" x)) 
                  (vl-directory-files a "*.lsp" 1) 
                ) 
              ) 
        (list 
          (strcat mp2 "L2F") 
          (strcat mp2 "L2F\\加载程序") 
          (strcat mp2 "L2F\\机械图框\\MECpg") 
          (strcat mp2 "PsAddLsp") 
          (strcat mp2 "DxmlPlus") 
          (strcat mp1 "cao.y\\加载程序") 
          (strcat mp1 "\\MyCAD\\加载程序") 
        ) 
      ) 
    ) 
  ) 
   
  ;; 搜索文件 
  (setq fi 0) 
  (setq dm t) ; 标记是否找到任何匹配 
  (princ "\n以下文件包含代码段:") 
   
  (foreach fn flst 
    (setq ln 0) 
    (setq rf (open fn "r")) 
    (setq r1 (read-line rf)) 
    (setq gn 0) ; 当前文件的匹配计数 
    
    (while r1 
      (setq ln (1+ ln)) 
       
      ;; 检查是否匹配 
      (setq e1 
        (if (= key "Yes") 
          (wcmatch (strcase r1) (strcat "*" (strcase str) "*")) 
          (wcmatch r1 (strcat "*" str "*")) 
        ) 
      ) 
       
      (if e1 
        (progn 
          (setq dm nil) ; 至少找到一个匹配 
          
          ;; 第一次匹配时显示文件名 
          (if (= gn 0) 
            (progn 
              (princ (strcat "\n\n文件名: " fn)) 
              (princ "\n匹配行:") 
            ) 
          ) 
          (setq gn (1+ gn)) 
          
          ;; 尝试获取更精确的匹配上下文 
          (setq catch (gocatch 
                       '(execute 
                         r1 
                         (strcat ".{0,10}" str ".{0,10}") 
                         nil 
                         nil 
                        ) 
                      )) 
          
          (if (car catch) 
            ;; 错误处理 
            (progn 
              (princ (strcat "\n错误停留文件: " fn)) 
              (princ (strcat "\n错误对应行: " (itoa ln))) 
              (princ "\n读取错误内容: ") 
              (princ r1) 
              (vl-bt) 
            ) 
            ;; 正常显示匹配 
            (progn 
              (princ (strcat "\n  行 " (itoa ln) ": ")) 
              (if (and (cadr catch) (car (cadr catch))) 
                (princ (car (cadr catch))) 
                (princ r1) 
              ) 
            ) 
          ) 
        ) 
      ) 
      (setq r1 (read-line rf)) 
    ) 
    (close rf) 
  ) 
   
  (if dm 
    (princ "\n没有找到代码段!") 
  ) 
  (princ) 
) 
 
;;1 我的文档 2 桌面 3其余 当前文件夹 
(defun mypath (num / wss spe desktop) 
  (setq wss (vlax-create-object "WScript.Shell")) 
  (setq spe (vlax-get-property wss "SpecialFolders")) 
  (setq Desktop (vlax-invoke-method spe "Item" "Desktop")) 
  (cond 
    ((= num 1) (strcat (getvar "mydocumentsprefix") "\\")) 
    ((= num 2) (strcat Desktop "\\")) 
    (t (getvar "DwgPrefix")) 
  ) 
) 
;; 辅助函数保持不变 
(defun gocatch (func / s e) 
  (setq s (vl-catch-all-error-p 
           (vl-catch-all-apply 
             '(lambda () (setq e (eval func))) 
           ) 
         ) 
  ) 
  (list s e) 
) 
 
(defun execute (str ex gm ic / r s lst a) 
  (setq r (vlax-create-object "vbscript.regexp")) 
  (if gm 
    (progn 
      (vlax-put-property r 'global -1) 
      (vlax-put-property r 'Multiline -1) 
    ) 
  ) 
  (if ic 
    (vlax-put-property r 'ignorecase -1) 
  ) 
  (vlax-put-property r 'pattern ex) 
  (setq s (vlax-invoke r 'execute str)) 
  (vlax-release-object r) 
  (vlax-for x s 
    (setq a (vlax-get-property x 'value)) 
    (setq lst (cons a lst)) 
  ) 
  (reverse lst) 
)

网友答: 我也有个类似的，只是没写对话框

网友答: