请高手帮我写一个在某布局插件某DWG文件为块参照的代码

清风明月10 · 发表于 2013-9-30 08:47:50

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

请高手帮我写一个在某布局插件某DWG文件为块参照的代码
求一个代码，即新建布局“A4”(如果原来有就不新建)，在布局“A4”中插入一个DWG文件“D:\Backup\我的文档\试验.dwg”作为块参照。

下面是两套可能有用的参照代码：

(DEFUN C:新建名为建设的布局()
;;;  来源：6楼请教大家Lisp怎么对布局进行操作呢-AutoLISP/Visual LISP 编程技术-CAD论坛-明经CAD社区 - Powered by Discuz!
;;;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=100499

(vla-add (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-acad-object))) "建设")
)

(defun c:在所有布局的同一点插入同一块 (/ p doc layouts)
;;;来源：8楼  晓东CAD家园-论坛-晓东工具箱、编程申请-求CAD布局中同时插入块或文字方法! - Powered by Discuz!
;;;http://bbs.xdcad.net/forum.php?mod=viewthread&tid=669003
  (if (setq p (getpoint "\nInsertpoint: "))
(progn
   (setq doc    (vla-get-activedocument (vlax-get-acad-object))
   layouts (vla-get-layouts doc)
   )
   (vlax-for layout layouts
;;; (vla-addtext
;;; (vla-get-block layout)
;;; "This is Testing!"
;;; (vlax-3d-point p)
;;; 10.
;;; )
(vla-insertblock
   (vla-get-block layout)
   (vlax-3d-point p)
   "00指北针";_改为自己块名称
   1;_x 比例
   1;_y比例
   1;_z比例
   0;_旋转角度
)

   )
   (vlax-release-object doc)
   (vlax-release-object layouts)
)
  )
  (princ)
)

st788796 · 发表于 2013-9-30 11:36:14

1 取文件用 Getfiled
2 vlax-for 遍历改为(vla-insertblock (vla-get-block (vla-item layouts "建设")) ....

清风明月10 · 发表于 2013-9-30 12:07:03

本帖最后由清风明月10 于 2013-9-30 12:08 编辑

谢谢
新建“建设”布局，如果已有，就会出错，不知道如何避免出错问题。

清风明月10 · 发表于 2013-9-30 12:10:26

还有一个根本性问题，“vla-get-activedocument”这些函数到哪里去查帮助？
如果能查到帮助，就可以灵活运用了

清风明月10 · 发表于 2013-9-30 12:35:42

下面为新建"布局1"，但如果"布局1"存在，就会出错，请教如何能够顺利执行避免错误！

(defun c:TT (/ p doc layouts)
;在布局1某点插入某块
  ;;来源：8楼  晓东CAD家园-论坛-晓东工具箱、编程申请-求CAD布局中同时插入块或文字方法! - Powered by Discuz!
;;;http://bbs.xdcad.net/forum.php?mod=viewthread&tid=669003
;;;  (if (setq p (getpoint "\nInsertpoint: "))
;;;下面为新建"布局1"，但如果"布局1"存在，就会出错，请教如何能够顺利执行避免错误！
  (vla-add (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-acad-object))) "布局1")

  (if (setq p (list 0 0 0))
(progn
   (setq doc    (vla-get-activedocument (vlax-get-acad-object))
   layouts (vla-get-layouts doc)
   )
   ; (vlax-for layout layouts
;;; (vla-addtext
;;; (vla-get-block layout)
;;; "This is Testing!"
;;; (vlax-3d-point p)
;;; 10.
;;; )
(vla-insertblock
   (vla-get-block (vla-item layouts "布局1") )
   (vlax-3d-point p)
   "00指北针";_改为自己块名称
   1;_x 比例
   1;_y比例
   1;_z比例
   0;_旋转角度
)

   ; )
   (vlax-release-object doc)
   (vlax-release-object layouts)
)
  )
  (princ)
)

Free-Lancer · 发表于 2013-9-30 12:45:58

本帖最后由 Free-Lancer 于 2013-9-30 12:50 编辑

(if (not (member "建设"(layouts))) …)
那些是 ActiveX lisp 用法，你懂VBA很容易上手的，help 目录acadauto.chm

清风明月10 · 发表于 2013-9-30 13:55:19

最终结果，与大家共享
(defun c:TT (/ p doc layouts)
;在布局1某点插入某块
  ;;来源：8楼  晓东CAD家园-论坛-晓东工具箱、编程申请-求CAD布局中同时插入块或文字方法! - Powered by Discuz!
;;;http://bbs.xdcad.net/forum.php?mod=viewthread&tid=669003
;;;  (if (setq p (getpoint "\nInsertpoint: "))
;;;下面为不存在"布局1"，则新建"布局1"！
(setq ls (vla-get-layouts (vla-get-ActiveDocument (vlax-get-acad-object))))
(if (vl-catch-all-error-p (vl-catch-all-apply (function vla-item) (list ls "布局1")))
(vla-add ls "布局1"))
  (if (setq p (list 0 0 0))
(progn
   (setq doc    (vla-get-activedocument (vlax-get-acad-object))
   layouts (vla-get-layouts doc)
   )
   ; (vlax-for layout layouts
;;; (vla-addtext
;;; (vla-get-block layout)
;;; "This is Testing!"
;;; (vlax-3d-point p)
;;; 10.
;;; )
(vla-insertblock
   (vla-get-block (vla-item layouts "布局1") )
   (vlax-3d-point p)
   "D:\\Backup\\我的文档\\试验.dwg";_改为自己块名称
   1;_x 比例
   1;_y比例
   1;_z比例
   0;_旋转角度
)
   ; )
   (vlax-release-object doc)
   (vlax-release-object layouts)
)
  )
  (princ)
)

st788796 · 发表于 2013-9-30 14:44:13

清风明月10 发表于 2013-9-30 13:55
最终结果，与大家共享
(defun c:TT (/ p doc layouts)
;在布局1某点插入某块

(defun c:tt (/ dwg block layout p)
(if (setq dwg (getfiled "Select DWG to Insert" "" "DWG" 8))
(progn
(if (member "布局1" (layoutlist))
(setq
block (vla-get-block
(setq layout (vla-item
(vla-get-layouts
(vla-get-activedocument
(vlax-get-acad-object)
)
)
"布局1"
)
)
)
)
(setq
block (vla-get-block
(setq layout (vla-add
(vla-get-layouts
(vla-get-activedocument
(vlax-get-acad-object)
)
)
"布局1"
)
)
)
)
)
(if (= (getvar "tilemode") 1)
(vla-put-ActiveLayout
(vla-get-activedocument (vlax-get-acad-object))
layout
)
)
(if (setq p (getpoint "\nInsert point: "))
(vla-insertblock block (vlax-3d-point p) dwg 1. 1. 1. 0.)
)
)
)
(princ)
)

(defun c:tt (/ dwg block layout p) 
  (if (setq dwg (getfiled "Select DWG to Insert" "" "DWG" 8)) 
    (progn 
      (if (member "布局1" (layoutlist)) 
 (setq 
   block (vla-get-block 
    (setq layout (vla-item 
     (vla-get-layouts 
       (vla-get-activedocument 
         (vlax-get-acad-object) 
       ) 
     ) 
     "布局1" 
          ) 
    ) 
  ) 
 ) 
 (setq 
   block (vla-get-block 
    (setq layout (vla-add 
     (vla-get-layouts 
       (vla-get-activedocument 
         (vlax-get-acad-object) 
       ) 
     ) 
     "布局1" 
          ) 
    ) 
  ) 
 ) 
      ) 
      (if (= (getvar "tilemode") 1) 
 (vla-put-ActiveLayout 
   (vla-get-activedocument (vlax-get-acad-object)) 
   layout 
 ) 
      ) 
      (if (setq p (getpoint "\nInsert point: ")) 
 (vla-insertblock block (vlax-3d-point p) dwg 1. 1. 1. 0.) 
      ) 
    ) 
  ) 
  (princ) 
)

st788796 · 发表于 2013-9-30 19:51:46

布局到布局?图形是否打开?

清风明月10 · 发表于 2013-9-30 19:54:49

没打开，只是提供路径例如：“D:\00邓细木CAD插件汇总\CAD每天使用的图形样板文件（尾缀dwt）Template文件夹\000000DXM每天新建CAD文件的模板.dwt”

st788796 · 发表于 2013-9-30 21:27:05

清风明月10 发表于 2013-9-30 19:54
没打开，只是提供路径例如：“D:\00邓细木CAD插件汇总\CAD每天使用的图形样板文件（尾缀dwt）Template文件 ...

这个 CopyObjects 很少用，需要时在论坛搜个帖子，比照着写

(defun c:tt (/ fl *acad* DBXDoc l itemps)
(if (setq fl (getfiled "Select DWG" "" "Dwg;Dwt" 8))
(progn
(setq *acad* (vlax-get-acad-object)
DBXDoc (vla-GetInterfaceObject
*acad*
(if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
"ObjectDBX.AxDbDocument"
(strcat "ObjectDBX.AxDbDocument." (itoa acVer))
)
)
)
(defun itemps (col / l)
(vlax-for i col
(if (/= (vla-get-objectname i) "AcDbViewport")
(setq l (cons i l))
)
)
(reverse l)
)
(vla-open DBXDoc fl)
(vlax-invoke
dbxdoc
'copyobjects
(list (vla-item (vla-get-layouts dbxdoc) "布局1"))
(vla-get-layouts
(vla-get-activedocument *acad*)
)
) ;_复制布局
(if (setq l (itemps (vla-get-paperspace dbxdoc)))
(vlax-invoke
dbxdoc
'copyobjects
l
(vla-get-paperspace
(vla-get-activedocument *acad*)
)
) ;_复制图纸空间实体
)
(vlax-release-object dbxdoc)
)
)
(princ)
)

(defun c:tt (/ fl *acad* DBXDoc l itemps) 
  (if (setq fl (getfiled "Select DWG" "" "Dwg;Dwt" 8)) 
    (progn 
      (setq *acad* (vlax-get-acad-object) 
     DBXDoc (vla-GetInterfaceObject 
       *acad* 
       (if (< (setq acVer (atoi (getvar "ACADVER"))) 16) 
         "ObjectDBX.AxDbDocument" 
         (strcat "ObjectDBX.AxDbDocument." (itoa acVer)) 
       ) 
     ) 
      ) 
      (defun itemps (col / l) 
 (vlax-for i col 
   (if (/= (vla-get-objectname i) "AcDbViewport") 
     (setq l (cons i l)) 
   ) 
 ) 
 (reverse l) 
      ) 
      (vla-open DBXDoc fl) 
      (vlax-invoke 
 dbxdoc 
 'copyobjects 
 (list (vla-item (vla-get-layouts dbxdoc) "布局1")) 
 (vla-get-layouts 
   (vla-get-activedocument *acad*) 
 ) 
      ) ;_复制布局 
      (if (setq l (itemps (vla-get-paperspace dbxdoc))) 
 (vlax-invoke 
   dbxdoc 
   'copyobjects 
   l 
   (vla-get-paperspace 
     (vla-get-activedocument *acad*) 
   ) 
 ) ;_复制图纸空间实体 
      ) 
      (vlax-release-object dbxdoc) 
    ) 
  ) 
  (princ) 
)

清风明月10 · 发表于 2013-9-30 21:33:29

(defun c:导入布局剖面图3横深勘东莞 ()
;;;自己写的
(COMMAND "LAYOUT" "T" "D:\\00CAD插件汇总\\CAD每天使用的图形样板文件（尾缀dwt）Template文件夹\\000钻孔剖面图所有布局深勘东莞DXM.dwt" "剖面图3横深勘东莞")
)

账号		自动登录	找回密码
密码			立即注册

[求助] 请高手帮我写一个在某布局插件某DWG文件为块参照的代码

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

评分

点评

评分