cad.net之ACAD移植到GCAD的自动加载问题

最新推荐文章于 2022-03-28 22:50:42 发布

weixin_30908649

最新推荐文章于 2022-03-28 22:50:42 发布

阅读量267

点赞数

原文链接：http://www.cnblogs.com/JJBox/p/10209549.html

版权

将acad.pgp,lsp,fas,vlx,名称增加一份gcad.pgp,lsp,fas,vlx.涉及系统加载用.

Lisp的拖拉加载在gcad无法通过lastprompt获取命令历史栏最后一行(含路径字符串),请改用_.copyhist命令实现拖拉加载...以下代码贴出两种拖拉方式.

;;;name:    BF-Catalog
;;;desc:    设置基础目录
;;;arg:     #xdlj:字符串
;;;return:  成功:工具箱基础目录, 失败:输出警告提示
;;;example: (BF-Catalog "04.工作小工具\\Notepad2.exe")
;;;example: (BF-Catalog "")      -> "D:\\K01.惊惊盒子\\"
(if (not BF-Catalog)
    (progn
        ;拖拉添加信任目录
        (vl-catch-all-apply ;捕获错误
         '(lambda  (/ str nn str1 html)
            (while (= (logand (getvar "CmdActive") 1) 1)(command));结束已有命令
            (princ  "\n")
            ;字符串处理,得到完整路径:
            ;ACAD最后一句内容:"命令: (LOAD \"D:/桌面/新建文本文档.lsp\")"
            ;GCAD无法获取最后一句内容
            (if (getvar "GCADVER");是浩辰
                (progn ;是执行
                    (command "_.copyhist")
                     (setq html (vlax-create-object "htmlfile"))
                     (setq str (vlax-invoke-method (vlax-get (vlax-get html 'parentwindow) 'clipboarddata) 'getdata "text")
                           str (strcase (if (= (type str) 'variant) (vlax-variant-value str) str))
                     )
                    (setq str (vl-string-right-trim " " str))
                    (while (vl-string-search "\r\n" str)
                           (setq str (vl-string-subst "" "\r\n" str))
                    )
                    (while (setq nn (vl-string-search "(LOAD \"" str))
                           (setq str (substr str (+ nn 8)))
                    )
                    (and (setq nn (vl-string-search "\")" str))
                         (setq str (substr str 1 (1+ nn))) ;file name
                    )
                    (setq str (vl-filename-directory (vl-string-translate "/" "\\" str)))
                    (and html (vlax-release-object html))
                )
                (progn ;acad也可以用_.copyhist的方法的,这里只是展示lastprompt的用法,但是浩辰无法用lastprompt
                   (setq
                     str1 (getvar "lastprompt")           ;获得最后一行命令
                     nn (vl-string-search "(LOAD \"" str1);在字符串中搜索指定子串
                   )
                   (if nn
                     (progn
                       (setq
                         str (substr str1 (+ nn 8))          ;去掉前面的
                         nn (vl-string-search "\")" str)     ;在字符串中搜索指定子串
                         str (substr str 1 (1+ nn))          ;去掉文件名称
                         str (vl-filename-directory (vl-string-translate "/" "\\" str));转化
                       )
                     )
                   )
                )
            )
            (if str
               (progn
                 ;添加信任目录
                 (@add-Catalog str (list "" "02.小插件" "06.填充" "Fonts"))

                 ;定义惊惊盒子基础目录
                 (eval (list 'defun 'BF-Catalog '(#xdlj)(list 'strcat (strcat str "\\")'#xdlj)))
               )
            )
          )
        )
    )
)

;;;name:@add-Catalog
;;;desc:加入信任路径
;;;arg:#str:基础路径
;;;arg:#fname:文件夹名
;;;return:什么都不返回
;;;example:(@add-Catalog "D:\\K01.惊惊盒子" (list "01.程序")),不可以末尾有\\
(defun @add-Catalog
  (str fname / wanzhenglujing acadPath acadPaths)
  (foreach zibiao fname
    (if (= zibiao "")
        (setq wanzhenglujing str)
        (setq wanzhenglujing (strcat str "\\" zibiao))
    )
    (if (findfile wanzhenglujing);路径是否存在
        (progn
           ;路径是否重复
           (setq acadPath (getenv "ACAD"))
           (setq acadPaths (BF-Str-Split acadPath ";"))
           (foreach zibiao2 acadPaths
              (if (/= (strcase  zibiao2)(strcase wanzhenglujing));转大写
                  (setenv "ACAD" (strcat wanzhenglujing ";" acadPath))
              )
           )
        )
    )
  )
  (princ)
)

拖拉加载时候更改加载的dll方式,增加gcad部分,利用它特有的变量.acad会忽视这个变量的.

  (if (getvar "GCADVER");浩辰
      (progn 
          (setq
            tmp_ver (substr (getvar "ACADVER") 1 4)
            tmp_str (cond
                      ((= tmp_ver "19.0") "JJBoxGstarCad_2019.dll")
                      (T nil)
                    )
          )
      )
      (progn ;acad加载
          (setq
            tmp_ver (substr (getvar "ACADVER") 1 4)
            tmp_str (cond
                      ((= tmp_ver "16.2") "JJBoxDeskCad_2006.dll")
                      ((= tmp_ver "17.0") "JJBoxDeskCad_2007.dll")
                      ((= tmp_ver "17.1") "JJBoxDeskCad_2008.dll")
                      ((= tmp_ver "17.2") "JJBoxDeskCad_2009.dll")
                      ((= tmp_ver "18.0") "JJBoxDeskCad_2010.dll")
                      ((= tmp_ver "18.1") "JJBoxDeskCad_2011.dll")
                      ((= tmp_ver "18.2") "JJBoxDeskCad_2012.dll")
                      ((= tmp_ver "19.0") "JJBoxDeskCad_2013.dll")
                      ((= tmp_ver "19.1") "JJBoxDeskCad_2014.dll")
                      ((= tmp_ver "20.0") "JJBoxDeskCad_2015.dll")
                      ((= tmp_ver "20.1") "JJBoxDeskCad_2016.dll")
                      ((= tmp_ver "21.0") "JJBoxDeskCad_2017.dll")
                      ((= tmp_ver "22.0") "JJBoxDeskCad_2018.dll")
                      ((= tmp_ver "23.0") "JJBoxDeskCad_2019.dll")
                      (T nil)
                    )
          )
      )
  )

(if (and tmp_str
(findfile tmp_str);在支持路径内
)
(command "netload" (findfile tmp_str));截获错误加载
)

gcad注册表和acad注册表有点区别,少了语言版本及区域版本,而arx和dll重复加载的注册表位置和acad不同的地方是 HKEY_CURRENT_USER\SOFTWARE\Gstarsoft\GstarCAD\R19\zh-CN\

要增加Applications项(不是Application),之后设置和acad的Applications一样.(这里浩辰居然没有空置一个,要自己去添加 - . - )