图块打包生成lsp程序 ss2lsp_CAD中文技术交流网

图块打包生成lsp程序 ss2lsp

本帖最后由 wzg356 于 2023-11-29 11:27 编辑

这个是http://bbs.mjtd.com/thread-184666-1-1.html的一部分，剥离出来
固版也写有一个

图块打包生成插入图块的lsp程序--------可用于建立管理符号库/块
支持 '((0 . "*LINE,CIRCLE,ARC,ELLIPSE,3DFACE,*TEXT,DIMENSION,INSERT,ATTDEF,HATCH,LEADER,MULTILEADER"))
包含属性块，动态块不支持
复杂填充处理有点缺陷
尽量用常用的自定义线型、填充、字体等
样式bug已修符
DIMENSION对象群码表没有的箭头、尺寸线等属性全部随样式
命令ss2lsp

可以按下面写法改写是否还支持其他图元

下面是启动函数的写法（已在fas里面）
这里只打包一个选择集
生成的插入块程序在C盘根目录
生成的程序函数名按时间序列命名，避免重名
生成的插入图块程序xxx.lsp里面顶部有备注用法
(defun c:ss2lsp( / filters ss strs funstr)
(if       (and(setq ss(ssget
      '((0 . "*LINE,CIRCLE,ARC,ELLIPSE,3DFACE,*TEXT,DIMENSION,INSERT,ATTDEF,HATCH,LEADER,MULTILEADER"))
            ))
            (setq funstr(strcat"X"(substr(rtos(* (getvar "cdate")1e4)2 0)5)))
            (setq strs(sss2lsp(list ss) funstr))
      )(progn
      (setq funstr(strcat "c:\\"funstr".lsp"))
      (setq f(open funstr "w"))
      (foreach str strs(write-line str f))
      (close f)
      (alert(strcat"\n成功输出文件"funstr))
))
)

需要扩展使用的，(sss2lsp(list ss1 ss2 .....) "函数名");返回ss1 ss2的插入程序字符串

网友答:

KO你发表于 2025-8-28 10:53
思路正确，但我不懂怎么操作，你能用LISP写一个程序出来吗

或者把步骤过程演变出来

把多个动态块直接DXFOUT导出为WRAPDBLK.DXF，然后重命名为WRAPDBLK.TXT。创建VLX时，在资源文件那里选TXT文件并将WRAPDBLK.TXT加入。

将代码中的DYN1修改为其中一个动态块的块名，编译为VLX后，执行IMDB即可导入所有动态块定义。

(Defun C:IMDB (/ SaveDXF DAT DOC DXF FNN OLD)
(Defun SaveDXF (dat fnn / ADO)
(setq ado (vlax-create-object "ADODB.Stream"))
(vlax-put-property ado "Type" 1)
(vlax-invoke ado "Open" nil nil nil nil nil)
(vlax-invoke-method
ado
"Write"
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
17
(cons 0 (1- (length dat)))
)
dat
)
)
)
(vlax-invoke-method ado "saveToFile" fnn 2)
(vlax-invoke-method ado "Close")
(vlax-release-object ado)
(findfile fnn)
)
(and (null (tblsearch "Block" "DYN1"))
(setq dat (vl-catch-all-apply 'vl-get-resource (list "WRAPDBLK")))
(not (vl-catch-all-error-p dat))
(setq dxf (SaveDXF (vl-string->list dat)
(strcat (car (fnsplitl (vl-filename-mktemp)))
"WRAPDBLK.dxf"
)
)
)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(progn
(setq old (entlast))
(vla-import doc dxf (vlax-3d-point '(0. 0. 0.)) 1.)
(if old
(while (setq old (entnext old)) (entdel old))
(while (setq old (entlast)) (entdel old))
)
(vl-file-delete dxf)
(and (tblsearch "Block" "WRAPDBLK")
(vla-erase (vla-item (vla-get-blocks doc) "WRAPDBLK"))
)
)
)
(tblsearch "Block" "DYN1")
)

(Defun C:IMDB (/ SaveDXF DAT DOC DXF FNN OLD) 
  (Defun SaveDXF (dat fnn / ADO) 
    (setq ado (vlax-create-object "ADODB.Stream")) 
    (vlax-put-property ado "Type" 1) 
    (vlax-invoke ado "Open" nil nil nil nil nil) 
    (vlax-invoke-method 
      ado 
      "Write" 
      (vlax-make-variant 
  (vlax-safearray-fill 
    (vlax-make-safearray 
      17 
      (cons 0 (1- (length dat))) 
    ) 
    dat 
  ) 
      ) 
    ) 
    (vlax-invoke-method ado "saveToFile" fnn 2) 
    (vlax-invoke-method ado "Close") 
    (vlax-release-object ado) 
    (findfile fnn) 
  ) 
  (and (null (tblsearch "Block" "DYN1")) 
       (setq dat (vl-catch-all-apply 'vl-get-resource (list "WRAPDBLK"))) 
       (not (vl-catch-all-error-p dat)) 
       (setq dxf (SaveDXF (vl-string->list dat) 
        (strcat (car (fnsplitl (vl-filename-mktemp))) 
          "WRAPDBLK.dxf" 
        ) 
     ) 
       ) 
       (setq doc (vla-get-activedocument (vlax-get-acad-object))) 
       (progn 
   (setq old (entlast)) 
   (vla-import doc dxf (vlax-3d-point '(0. 0. 0.)) 1.) 
   (if old 
     (while (setq old (entnext old)) (entdel old)) 
     (while (setq old (entlast)) (entdel old)) 
   ) 
   (vl-file-delete dxf) 
   (and (tblsearch "Block" "WRAPDBLK") 
        (vla-erase (vla-item (vla-get-blocks doc) "WRAPDBLK")) 
   ) 
       ) 
  ) 
  (tblsearch "Block" "DYN1") 
)

网友答: ;;;===============
(DEFUN X11212102ENTALL (E / ENT SS ENV) (SETQ ENT E) (DEFUN ENV (ENT) (MEMBER (CDR (ASSOC 0 (ENTGET ENT))) (QUOTE ("ATTRIB" "VERTEX" "SEQEND")))) (SETQ SS (SSADD)) (IF (OR ENT (AND (SETQ ENT (ENTNEXT)) (IF (NOT (ENV ENT)) (SSADD ENT SS)))) (WHILE (SETQ ENT (ENTNEXT ENT)) (IF (NOT (ENV ENT)) (SSADD ENT SS)))) SS)
; 错误: 参数类型错误: streamp nil

网友答:

KO你发表于 2025-6-15 13:08
我也是这样想的，有什么方法把DWG文件打包在fas文件或vlx文件里，再输入命令运行插入。我记得论坛有打包 ...

更简单的处理方式，将一个或多个图块保存为DXF文件，然后修改后缀为TXT，将其作为资源文件添加到VLX中，运行时先vl-getresource提取TXT内容，写入保存为DXF文件，然后insert DXF就有了图块定义，包括动态块。

网友答: 这是好东西啊，谢谢楼主分享。

网友答: 谢谢楼主分享

网友答: 谢谢楼主分享

网友答: 带有文字和标注的样式会丢

网友答: 本帖最后由 wzg356 于 2023-11-21 18:24 编辑

hao3ren 发表于 2023-11-21 15:55
带有文字和标注的样式会丢

文字样式修复了，宋体原因，另外样式名别用standard

标注样式属性有待改建

网友答:
谢谢楼主分享

网友答: 样式bug已修符

网友答: 谢谢楼主分享

上一篇：坐标集就质心

下一篇：没有了