本帖最后由 vitalgg 于 2023-11-29 17:16 编辑
 - ;; 加载@lisp函数库
- (progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))
- ;; 修改以下配置信息===================================
- (setq framename "图框块名") ;; 你的图框块名
- (setq signs '("签名1" "签名2")) ; 手写签名块的名称
- ;; ==================================================
- ;; 功能:清空DBX对象中属性块的属性值
- (defun dbx-clean-att (dwg-file / blk-obj blk3)
- ;; 打开外部dwg的DBX对象. 假定文件为 D:/abc.dwg
- (setq dwg-file (findfile dwg-file))
- (dbx:open dwg-file)
- ;;取dbx中的模型空间中的实体
- (setq dbx-ms(vla-get-modelspace *DBX*))
- ;; 取dbx块集中的第4个块定义对象(前几个是model-space paper-space之类的)
- (setq n 0)
- (repeat (vla-get-count dbx-ms)
- (setq obj% (vla-item dbx-ms n))
- (print (vla-get-objectname obj%))
- (cond
- ;; 将图框块中的设计、校对的属性值清空
- ((and (= (vla-get-objectname obj%) "AcDbBlockReference")
- (= (vla-get-HasAttributes obj%) :vlax-true)
- (= (vla-get-effectivename obj%) framename)
- )
- ;;清空属性值
- (block:set-attributes obj% '(("设计" . "")("校对" . ""))))
- ;; 删除签名块
- ((and (= (vla-get-objectname obj%) "AcDbBlockReference")
- (member (vla-get-effectivename obj%)
- signs
- ))
- (vla-delete obj%)
- ))
- (setq n (1+ n)))
- (setq tmp-file (strcat dwg-file ".b.dwg"))
- (vla-saveas *DBX* tmp-file)
- ;;(vla-save *DBX*) ;; 新版本DBX不支持直接写入
- (dbx:release)
- (if (and (findfile tmp-file)
- (> (vl-file-size tmp-file) 0))
- (progn
- (vl-file-delete dwg-file)
- (vl-file-rename tmp-file dwg-file))
- ))
|