明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 92|回复: 3

[源码] 哪位有支持中望cad自动加载LSP、dll文件的源码吗?

[复制链接]
发表于 5 小时前 | 显示全部楼层 |阅读模式
群里有很多ACAD自动加载lsp、dll并自动加入自启动的程序,但是找了一圈没有支持中望cad自动加载LSP、dll这些文件并加入自启动的源码。下面这个源码我改了很久,就是不行,有哪位大神能帮帮忙吗?
;+++++++++++++++++++++++++++++++++++++++++++
                  子函数
;功能描述:自动加载kk-Autoload.lsp 所处文件夹下的文件及其子文件夹下的文件。支持lsp、vlx、fas、arx、dll(netload方式加载)。
;+++++++++++++++++++++++++++++++++++++++++++
|;

;┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄
;功能:拖拽文件进入cad中,返回拖拽的文件路径
(defun kk-getdragpath (/ str_path n1 n2)
  (while (/= 0 (getvar "cmdactive")) (command))
  (princ "\n")
  (setq str_path (getvar "lastprompt"))
  (setq n1 (vl-string-search "(LOAD \"" str_path))
  (if (/= nil n1)
    (progn
      (setq n2 (vl-string-search "\")" str_path)
            str_path (substr str_path (+ n1 8) (- n2 n1 7))
            str_path (vl-filename-directory str_path)
      )
    )
    nil
  )
)

;┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄
;功能:返回表中缺失的文字标签(tag)
(defun kk-strtag (int_i int_pat str_para list_para / list_r i temp_str)
  (setq i int_i)
  (repeat (length list_para)
    (if (= int_pat 0)
      (setq temp_str (strcat (itoa i) str_para))
      (setq temp_str (strcat str_para (itoa i)))
    )
    (if (not (member temp_str list_para))
      (setq list_r (cons temp_str list_r))
    )
    (setq i (1+ i))
  )
  (reverse list_r)
)

;┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄
;功能:文件添加至AutoCAD启动组
(defun kk-file2startup (str_file / str_startup str_appload list_regvalue x bool_temp)
  (setq str_startup (strcat
                      "HKEY_CURRENT_USER\\"
                      (vlax-product-key)
                      "\\Profiles\\"
                      (vla-get-activeprofile
                        (vla-get-profiles (vla-get-preferences (vlax-get-acad-object)))
                      )
                      "\\Dialogs\\Appload\\Startup"
                    )
  )
  (setq str_appload (strcat
                      "HKEY_CURRENT_USER\\"
                      (vlax-product-key)
                      "\\Applications\\AcadAppload"
                    )
  )
  (setq list_regvalue (vl-registry-descendents str_startup ""))
  
  ; 检查是否已存在
  (cond
    ((= list_regvalue nil) (= nil bool_temp))
    ((/= list_regvalue nil)
     (foreach x list_regvalue
       (if (= (strcase str_file) (strcase (vl-registry-read str_startup x)))
         (setq bool_temp t)
       )
     )
    )
  )
  
  ; 添加到启动组
  (cond
    ((= nil bool_temp)
     (vl-registry-write
       str_startup
       "NumStartup"
       (vl-princ-to-string
         (1+ (read (vl-registry-read str_startup "NumStartup")))
       )
     )
     (vl-registry-write
       str_startup
       (car (kk-strtag 1 0 "Startup" list_regvalue))
       str_file
     )
     (vl-registry-write str_appload "LOADCTRLS" 15)
    )
  )
  (princ)
)

;┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄
;功能:获取路径下的文件夹及子文件夹
(defun kk-getFolds (str_path int_pat / list_fold)
  (defun _temp_getsonFold (sonpath)
    (setq list_fold (cons sonpath list_fold))
    (foreach x (cddr (vl-directory-files sonpath nil -1))
      (_temp_getsonFold (strcat sonpath "\\" x))
    )
  )
  (cond
    ((= 0 int_pat)
     (if (findfile str_path)
       (progn
         (setq list_fold (cons str_path list_fold))
         (foreach x (cddr (vl-directory-files str_path nil -1))
           (setq list_fold (cons (strcat str_path "\\" x) list_fold))
         )
       )
     )
    )
    ((= 1 int_pat) (if (findfile str_path) (_temp_getsonFold str_path)))
  )
  (cdr (reverse list_fold))
)

;┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄
;功能:获取路径下的文件
(defun kk-getfiles (str_path str_pat int_pat / list_folds x y list_filename list_file)
  (cond
    ((= 0 int_pat) (setq list_folds (cons str_path list_folds)))
    ((= 1 int_pat) (setq list_folds (cons str_path (kk-getFolds str_path 1))))
  )
  (foreach x list_folds
    (setq list_filename (vl-directory-files x str_pat 1))
    (if (/= list_filename nil)
      (foreach y list_filename
        (setq list_file (cons (strcat x "\\" y) list_file))
      )
    )
  )
  (reverse list_file)
)

;┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄
;功能:加载文件列表
(defun kk-loadfile (list_files int_debug / i inf x tempstr)
  (setq i 0)
  (foreach x list_files
    (setq tempstr (strcase x))
    (setq inf nil)
    (cond
      ((or
         (vl-string-search ".VLX" tempstr)
         (vl-string-search ".FAS" tempstr)
         (vl-string-search ".LSP" tempstr)
       )
       (setq inf (vl-catch-all-apply 'load (list x)))
      )
      ((vl-string-search ".DLL" tempstr)
       (vl-cmdf "netload" x)
      )
      ((or
         (vl-string-search ".ARX" tempstr)
         (vl-string-search ".DVB" tempstr)
         (vl-string-search ".DBX" tempstr)
       )
       (setq inf (vl-catch-all-apply 'arxload (list x)))
      )
    )
    (if (and (vl-catch-all-error-p inf) (= 1 int_debug))
      (progn
        (setq i (1+ i))
        (princ
          (strcat "\n("
                  (itoa i)
                  ") "
                  x
                  " 的加载error反馈:"
                  (vl-catch-all-error-message inf)
          )
        )
      )
    )
  )
)

;┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄
;功能:字符串替换
(defun kk-strreplace (str_new str_old str_father / i)
  (setq i 0)
  (while (vl-string-search str_old str_father i)
    (setq str_father (vl-string-subst str_new str_old str_father i))
    (setq i (+ i 1 (strlen str_new) (- (strlen str_old))))
  )
  str_father
)

;|
;+++++++++++++++++++++++++++++++++++++++++++
                  主函数
;+++++++++++++++++++++++++++++++++++++++++++
|;

;全局变量
(vl-bb-set
  'regpath_startup
  (strcat "HKEY_CURRENT_USER\\"
          (vlax-product-key)
          "\\Profiles\\"
          (vla-get-activeprofile
            (vla-get-profiles
              (vla-get-preferences (vlax-get-acad-object))
            )
          )
          "\\Dialogs\\Appload\\Startup"
  )
)
(vl-bb-set
  'regpath_appload
  (strcat "HKEY_CURRENT_USER\\" (vlax-product-key) "\\Applications\\AcadAppload")
)
(vl-bb-set 'regpaht_autoload "HKEY_CURRENT_USER\\Autoloadpath\\Paths")
(vl-bb-set 'regpaht_autoload_debug "HKEY_CURRENT_USER\\Autoloadpath\\Debug")
(vl-bb-set 'str_autoload_filename "拖入CAD绘图界面加载 自动批量自启动加载.lsp")

;主程序入口
(defun kk-autoload (/ int_oldsl str_name1 x list_reg_valuename list_files)
  (setvar "cmdecho" 0)
  
  ;/// 新增:判断是否为ZWCAD,跳过secureload设置 ///
  (if (not (wcmatch (strcase (getvar "PROGRAM")) "*ZWCAD*"))
    (setvar "secureload" 0)
  )
  
  (setq str_name1 (kk-getdragpath))
  (cond
    ((/= str_name1 nil)
     (setq str_name1 (kk-strreplace "\\" "/" (kk-getdragpath)))
     (kk-file2startup (strcat str_name1 "\\" (vl-bb-ref 'str_autoload_filename)))
    )
    ((= str_name1 nil)
     (setq list_reg_valuename (vl-registry-descendents
                                (vl-bb-ref 'regpath_startup)
                                ""
                              )
     )
     (foreach x list_reg_valuename
       (setq list_reg_valuedata (vl-registry-read (vl-bb-ref 'regpath_startup) x))
       (if (vl-string-search (vl-bb-ref 'str_autoload_filename) list_reg_valuedata)
         (setq str_name1 (vl-string-subst ""
                                          (strcat "\\"
                                                  (vl-bb-ref 'str_autoload_filename)
                                          )
                                          list_reg_valuedata
                         )
         )
       )
     )
    )
  )
  (setq list_files (kk-getfiles str_name1 "*.*" 0))
  (setq list_files (vl-remove
                     (strcat str_name1 "\\" (vl-bb-ref 'str_autoload_filename))
                     list_files
                   )
  )
  (if (/= nil list_files) (kk-loadfile list_files 0))
  (princ)
)

;加载主程序
(kk-autoload)
(print "工具箱加载成功!")
(princ)

回复

使用道具 举报

发表于 5 小时前 | 显示全部楼层
顶起来,期待大佬出手解决
回复 支持 反对

使用道具 举报

发表于 1 小时前 | 显示全部楼层
菜鸟初来乍到 发表于 2025-7-21 18:34
顶起来,期待大佬出手解决

直接问中望客服,会很快解决你的问题。
回复 支持 反对

使用道具 举报

发表于 半小时前 | 显示全部楼层
http://bbs.mjtd.com/plugin.php?i ... DE4NjMxfDE5MzAyMw==
我在这个地址下载的一个文件能把文件夹内的文件都加载了!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-7-21 23:55 , Processed in 0.241266 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表