加载云端的lsp代码

zml84

1. (vl-load-com)
   
2. (defun c:tt (/ url xPost startTime lispCode)
   
3.     "加载云端的lsp代码"
   
4. 
   
5.     ;; 云端 URL
   
6.     (setq url "https://tool.zml84.xyz/lisp/code_test/test.lsp")
   
7.    
   
8.     ;; 禁用缓存的方法1：URL添加时间戳参数
   
9.     (setq url (strcat url
   
10.           (if (vl-string-search "?" url)
    
11.                 "&"
    
12.                 "?"
    
13.           )
    
14.           "time="
    
15.           (rtos (getvar "CDATE") 2 6) ;_获取当前时间
    
16.         )
    
17.     )
    
18. 
    
19.     ;;尝试创建 XMLHTTP 对象
    
20.     (if  (setq xPost (vlax-get-or-create-object "Microsoft.XMLHTTP"))
    
21.         (progn
    
22. 
    
23.             ;; 同步打开连接
    
24.             (vlax-invoke-method xPost 'open "GET" url :vlax-false)
    
25. 
    
26.             ;; 禁用缓存的方法2：禁用缓存的完整实现
    
27.             (vlax-invoke-method
    
28.                 xPost
    
29.                 'SetRequestHeader
    
30.                 "If-Modified-Since"
    
31.                 "0"
    
32.             ) ;_设置请求头禁用缓存。
    
33.             (vlax-invoke-method
    
34.                 xPost
    
35.                 'SetRequestHeader
    
36.                 "Cache-Control"
    
37.                 "no-cache"
    
38.             ) ;_标准HTTP请求头指令，其作用为：客户端必须向服务器验证缓存有效性。与响应头中的 Cache-Control 不同，此处是客户端主动声明缓存策略。
    
39.             (vlax-invoke-method
    
40.                 xPost
    
41.                 'SetRequestHeader
    
42.                 "Pragma"
    
43.                 "no-cache"
    
44.             ) ;_针对HTTP/1.0客户端，与Cache-Control形成兼容性覆盖。
    
45.             (vlax-invoke-method
    
46.                 xPost
    
47.                 'SetRequestHeader
    
48.                 "Expires"
    
49.                 "0"
    
50.             ) ;_设置资源过期时间为过去时间，强制客户端重新请求。
    
51.             (vlax-invoke-method
    
52.                 xPost
    
53.                 'SetRequestHeader
    
54.                 "If-None-Match"
    
55.                 "*"
    
56.             ) ;_客户端要求服务器验证所有缓存版本，无论ETag（实体标签）具体值如何。
    
57. 
    
58.             ;; 发送请求
    
59.             (vlax-invoke-method xPost 'send)
    
60. 
    
61.             ;; 判断状态，并添加超时机制
    
62.             (setq startTime (getvar "DATE"))
    
63.             (while (and  (/= (vlax-get-property xPost 'readyState) 4)
    
64.                         (< (- (getvar "DATE") startTime) 5) ;_5秒超时
    
65.                     )
    
66.                 (princ "\r正在等待响应...")
    
67.             )
    
68. 
    
69.             ;; 检查请求是否成功完成
    
70.             (if  (and (= (vlax-get-property xPost 'readyState) 4)
    
71.                     (= (vlax-get-property xPost 'status) 200)
    
72.                 )
    
73.                 (progn
    
74.                     ;; 取出结果
    
75.                     (setq lispCode
    
76.                         (vlax-get-property xPost 'responseText)
    
77.                     )
    
78. 
    
79.                     ;; 显示内容
    
80.                     (print lispCode)
    
81. 
    
82.                     ;; 运行代码
    
83.                     (eval (read (strcat "(progn " lispCode ")")))
    
84.                 )
    
85.                 (princ (strcat "****出错啦。HTTP错误"
    
86.                         (itoa (vlax-get-property xPost 'status))
    
87.                         "："
    
88.                         (vlax-get-property xPost 'statusText)
    
89.                     )
    
90.                 )
    
91.             )
    
92. 
    
93.             ;; 释放资源
    
94.             (vlax-release-object xPost)
    
95.         )
    
96.         (princ "****出错啦。无法创建 XMLHTTP 对象。")
    
97.     )
    
98. 
    
99.     ;; 静默退出
    
100.     (princ)
     
101. )

(vl-load-com)<br /> (defun c:tt (/ url xPost startTime lispCode)<br />     "加载云端的lsp代码"<br /> <br />     ;; 云端 URL<br />     (setq url "https://tool.zml84.xyz/lisp/code_test/test.lsp")<br />     <br />     ;; 禁用缓存的方法1：URL添加时间戳参数<br />     (setq url (strcat url<br />           (if (vl-string-search "?" url)<br />                 "&"<br />                 "?"<br />           )<br />           "time="<br />           (rtos (getvar "CDATE") 2 6) ;_获取当前时间<br />         )<br />     )<br /> <br />     ;;尝试创建 XMLHTTP 对象<br />     (if  (setq xPost (vlax-get-or-create-object "Microsoft.XMLHTTP"))<br />         (progn<br /> <br />             ;; 同步打开连接 <br />             (vlax-invoke-method xPost 'open "GET" url :vlax-false)<br /> <br />             ;; 禁用缓存的方法2：禁用缓存的完整实现<br />             (vlax-invoke-method<br />                 xPost<br />                 'SetRequestHeader<br />                 "If-Modified-Since"<br />                 "0"<br />             ) ;_设置请求头禁用缓存。<br />             (vlax-invoke-method<br />                 xPost<br />                 'SetRequestHeader<br />                 "Cache-Control"<br />                 "no-cache"<br />             ) ;_标准HTTP请求头指令，其作用为：客户端必须向服务器验证缓存有效性。与响应头中的 Cache-Control 不同，此处是客户端主动声明缓存策略。<br />             (vlax-invoke-method<br />                 xPost<br />                 'SetRequestHeader<br />                 "Pragma"<br />                 "no-cache"<br />             ) ;_针对HTTP/1.0客户端，与Cache-Control形成兼容性覆盖。<br />             (vlax-invoke-method<br />                 xPost<br />                 'SetRequestHeader<br />                 "Expires"<br />                 "0"<br />             ) ;_设置资源过期时间为过去时间，强制客户端重新请求。<br />             (vlax-invoke-method<br />                 xPost<br />                 'SetRequestHeader<br />                 "If-None-Match"<br />                 "*"<br />             ) ;_客户端要求服务器验证所有缓存版本，无论ETag（实体标签）具体值如何。<br /> <br />             ;; 发送请求 <br />             (vlax-invoke-method xPost 'send)<br /> <br />             ;; 判断状态，并添加超时机制<br />             (setq startTime (getvar "DATE"))<br />             (while (and  (/= (vlax-get-property xPost 'readyState) 4)<br />                         (< (- (getvar "DATE") startTime) 5) ;_5秒超时<br />                     )<br />                 (princ "\r正在等待响应...")<br />             )<br /> <br />             ;; 检查请求是否成功完成<br />             (if  (and (= (vlax-get-property xPost 'readyState) 4)<br />                     (= (vlax-get-property xPost 'status) 200)<br />                 )<br />                 (progn<br />                     ;; 取出结果 <br />                     (setq lispCode<br />                         (vlax-get-property xPost 'responseText)<br />                     )<br /> <br />                     ;; 显示内容<br />                     (print lispCode)<br /> <br />                     ;; 运行代码 <br />                     (eval (read (strcat "(progn " lispCode ")")))<br />                 )<br />                 (princ (strcat "****出错啦。HTTP错误"<br />                         (itoa (vlax-get-property xPost 'status))<br />                         "："<br />                         (vlax-get-property xPost 'statusText)<br />                     )<br />                 )<br />             )<br /> <br />             ;; 释放资源<br />             (vlax-release-object xPost)<br />         )<br />         (princ "****出错啦。无法创建 XMLHTTP 对象。")<br />     )<br /> <br />     ;; 静默退出<br />     (princ)<br /> )

kozmosovia

hn10183051 发表于 2025-4-16 08:00
要能直接加载云端代码，怎么实现

在Gitee创建一个公共项目，然后把代码上传并记住路径，然后使用下面的VLDCL在线加载代码，将读取地址替换成你的lsp路径即可。

2. ((lambda (/ OA OB)
   
3.    (vl-load-com)
   
4.    (and  (setq OA "https://gitee.com/kozmos/tachyoncloud/raw/master/StableVLX/LoadVLDCL"
   
5.         OB (vlax-create-object "winhttp.winhttprequest.5.1")
   
6.   )
   
7.   (progn (vlax-invoke OB "open" "get" OA :vlax-true)
   
8.          (vlax-invoke OB "send")
   
9.          (vlax-invoke OB "WaitforResponse" 1000)
   
10.          (eval (read (vlax-get OB "ResponseText")))
    
11.          (setq OB (vlax-release-object OB))
    
12.   )
    
13.    )
    
14. )
    
15. )
    

((lambda (/ OA OB)<br />    (vl-load-com)<br />    (and  (setq OA "https://gitee.com/kozmos/tachyoncloud/raw/master/StableVLX/LoadVLDCL"<br />         OB (vlax-create-object "winhttp.winhttprequest.5.1")<br />   )<br />   (progn (vlax-invoke OB "open" "get" OA :vlax-true)<br />          (vlax-invoke OB "send")<br />          (vlax-invoke OB "WaitforResponse" 1000)<br />          (eval (read (vlax-get OB "ResponseText")))<br />          (setq OB (vlax-release-object OB))<br />   )<br />    )<br /> )<br /> )<br />

hn10183051

kozmosovia 发表于 2025-4-16 09:34
在Gitee创建一个公共项目，然后把代码上传并记住路径，然后使用下面的VLDCL在线加载代码，将读取地址替换 ...

哥，这个代码怎么只在每一个图形加载一次。我按照你的做法，程序加载一次，菜单栏又加载一次。有什么办法？

hn10183051

kozmosovia 发表于 2025-4-16 13:35
fas可以读取URL的FAS数据，不保存成文件而是转stream，再用隐藏函数加载stream

更加通用的方式是用CURL ...

下载（临时）目录，加载后删除，文件大了有点卡，

tigcat

大佬玩得高端.

hn10183051

想学习怎么做到的

i小小白i

有报错。不知道为什么

kozmosovia

你这好像读取的是个FAS或者VLX

hn10183051

要能直接加载云端代码，怎么实现

vink8023

hn10183051 发表于 2025-4-16 08:00
要能直接加载云端代码，怎么实现

可以实现

hn10183051

kozmosovia 发表于 2025-4-16 09:34
在Gitee创建一个公共项目，然后把代码上传并记住路径，然后使用下面的VLDCL在线加载代码，将读取地址替换 ...

如果是VLX或者fas呢

kozmosovia

fas可以读取URL的FAS数据，不保存成文件而是转stream，再用隐藏函数加载stream

更加通用的方式是用CURL或者XML下载VLX或者FAS到本地（临时）目录，加载后删除。