参考图纸图章

alanjt · 发表于 2022-7-6 10:47:14

??

(defun foo (/ ss)
 (foreach layout (layoutlist)
   (or (setq ss (ssget "_X" (list '(8 . "REFERENCE-TEXT") '(0 . "MTEXT") (cons 410 layout))))
       (entmakex (list '(0 . "MTEXT")
                       '(100 . "AcDbEntity")
                       '(100 . "AcDbMText")
                       '(10 0.5 2.0 0.0)
                       '(1 . "REFERENCE TEXT")
                       '(8 . "REFERENCE-TEXT")
                       '(40 . 0.25)
                       (cons 410 layout)
                 )
       )
   )
 )
)

Lee Mac · 发表于 2022-7-6 10:49:14

不客气，比尔

JohnM · 发表于 2022-7-6 10:53:35

账单
这是一台计算机还是多台计算机？
是否希望在打开任何图形时自动执行该操作，或者键入命令以运行该操作？
这是否仅适用于特定客户或任何打开的图纸？

BILL WILLIAMS · 发表于 2022-7-6 10:55:43

李，我等不及了。我必须在离开前试一试。我似乎无法让它工作。
附件是我的阿卡多克。lsp和我在底部附上了REFWG。
我哪里出错了？

;;2010年8月23日上午7:57自动创建acaddoc theswamp。组织
;;将所有文件写入目录（可能还有子目录）以加载到ACADDOC中。lsp
;;如果阿卡多克。未找到lsp，它将在保存路径中创建，如代码顶部所示。
;;不过，对于大量文件，我建议使用自动加载功能来节省内存。

（defun c:acaddoc（/SavePath f l）
（vl load com）
;; ©Lee Mac 2010
（setq保存路径
（条件

（（setq tmp（getvar’RoamablerOutprefix））
（或（eq“\\”（substr-tmp（strlen-tmp）））
（setq tmp（strcat tmp“\\”））
（strcat tmp“支持”）
)
（（setq tmp（findfile“ACAD.pat”））
（setq tmp（vl文件名目录tmp））
（或（eq“\\”（substr-tmp（strlen-tmp）））
（setq tmp（strcat tmp“\\”））
tmp公司
)
（t）
（弹出“Warning”16“DCL保存路径无效”）
（退出）
)
)
)
（或（setq f（findfile“ACADDOC.lsp”））
（setq f（strcat SavePath“ACADDOC.lsp”））
)
（if（and（setq l（LM:GetAllFiles nil T“*.lsp”））
（setq f（open f“a”））
（程序
（foreach x l
（写入行
（strcat）（负载）
（vl-prin1-to-string x）“\”加载失败：“（vl-filename base x）“\”）
)
f
)
)
（关闭f）
（princ（strcat“\n writed”（itoa（length l））“要加载到ACADDOC.lsp中的文件”）
)
（princ“\n*Cancel*”）
)
（普林斯）
)
;;--------------------=={Get All Files}==---------------；；
;;                                                          ;;
;;  检索所有文件或指定文件类型的文件；；
;;  驻留在目录（和子目录）中；；
;;------------------------------------------------------------;;
;;  作者：李，2010；；
;;                                                          ;;
;;  版权所有©2010 Lee McDonnell，保留所有权利；；
;;  联系人：Lee Mac@TheSwamp。组织，CADTutor。网
;;------------------------------------------------------------;;
;;  参数：；；
;;  Dir-[str]（可选）目录，如果nil函数将；；
;;       目录选择提示；；
;;  subs-[boole]如果T，则包括子目录；；
;;  文件类型-[str]（可选）文件类型的过滤器；；
;;------------------------------------------------------------;;
;;  返回：指定类型的VLA变量对象；；
;;------------------------------------------------------------;;
（defun LM:GetAllFiles（Dir Subs Filetype/GetSubFolders Shell Fold Dir）
（vl load com）
;; ©Lee Mac 2010

（defun GetSubFolders（文件夹/u f）
（地图车
（功能
（lambda（f）（setq _f（strcat文件夹“\\”f））
（cons \u f（应用（函数附加）
（GetSubFolders（f）））
)
)
（cddr（vl目录文件文件夹nil-1））
)
)
（条件
（（不是
（或
（和Dir（vl-file-directory-p Dir））
（程序
（setq外壳（vla getInterfaceObject
（setq ac（vlax get acad object））“Shell.Application”）
Fold（vlax invoke方法Shell’BrowseForFolder
（vla get HWND ac）“选择目录”512）
（vlax释放对象外壳）

（如果折叠
（程序
（setq Dir（vlax get属性
（vlax get property Fold“Self”路径）
（vlax释放物体折叠）

（和（“\\”（substr Dir（strlen Dir）））
（setq Dir（substr Dir 1（1-（strlen Dir Ю）Ю）））

目录
)
)
)
)
)
无
)
（（应用（函数附加）
（vl删除（报价为零）
（地图车
（功能
（lambda（文件路径）
（地图车
（功能
（lambda（文件名）
（strcat文件路径“\\”文件名）
)
)
（vl目录文件文件路径文件类型1）
)
)
)
（附加（列表目录）
（应用（函数附加）
（if subs（GetSubFolders Dir））
)
)
)
)
)
)
)
)
defun c：参考图纸（/str pos hgt）（vl load com）
（setq str“参考图纸”；文本字符串
位置'（0.5 2.0 0.0）；；文本位置
hgt 0.25；；文字高度
)
（vla添加文本
（vla获取纸张空间
（vla获取ActiveDocument
（vlax get acad对象）
)
)
str（vlax-3D-point pos）hgt
)
（普林斯）
)
（c：参考图纸）