设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › 请高手帮我写一个在某布局插件某DWG文件为块参照的代码 ...
返回列表 发新帖
查看: 1685|回复: 13

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

[复制链接]
清风明月10
发表于 2013-9-30 08:47:50 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
请高手帮我写一个在某布局插件某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)
)

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

st788796

已领礼包: 1268个

财富等级: 财源广进
发表于 2013-9-30 11:36:14 | 显示全部楼层
1 取文件用 Getfiled
2 vlax-for 遍历改为(vla-insertblock (vla-get-block  (vla-item layouts "建设")) ....
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

清风明月10
 楼主| 发表于 2013-9-30 12:07:03 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
本帖最后由 清风明月10 于 2013-9-30 12:08 编辑

谢谢
新建“建设”布局，如果已有，就会出错，不知道如何避免出错问题。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

清风明月10
 楼主| 发表于 2013-9-30 12:10:26 | 显示全部楼层
还有一个根本性问题，“vla-get-activedocument”这些函数到哪里去查帮助？
如果能查到帮助，就可以灵活运用了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

清风明月10
 楼主| 发表于 2013-9-30 12:35:42 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
下面为新建"布局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)
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

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
vba如何转换成LISP？我不懂，“acadauto.chm”我有，是纯正的VBA啊！  发表于 2013-9-30 14:01
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

清风明月10
 楼主| 发表于 2013-9-30 13:55:19 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
最终结果，与大家共享
(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)
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

st788796

已领礼包: 1268个

财富等级: 财源广进
发表于 2013-9-30 14:44:13 | 显示全部楼层
清风明月10 发表于 2013-9-30 13:55
最终结果，与大家共享
(defun c:TT (/ p doc layouts)
;在布局1某点插入某块

  1. (defun c:tt (/ dwg block layout p)
  2.   (if (setq dwg (getfiled "Select DWG to Insert" "" "DWG" 8))
  3.     (progn
  4.       (if (member "布局1" (layoutlist))
  5. (setq
  6.    block (vla-get-block
  7.     (setq layout (vla-item
  8.      (vla-get-layouts
  9.        (vla-get-activedocument
  10.          (vlax-get-acad-object)
  11.        )
  12.      )
  13.      "布局1"
  14.           )
  15.     )
  16.   )
  17. )
  18. (setq
  19.    block (vla-get-block
  20.     (setq layout (vla-add
  21.      (vla-get-layouts
  22.        (vla-get-activedocument
  23.          (vlax-get-acad-object)
  24.        )
  25.      )
  26.      "布局1"
  27.           )
  28.     )
  29.   )
  30. )
  31.       )
  32.       (if (= (getvar "tilemode") 1)
  33. (vla-put-ActiveLayout
  34.    (vla-get-activedocument (vlax-get-acad-object))
  35.    layout
  36. )
  37.       )
  38.       (if (setq p (getpoint "\nInsert point: "))
  39. (vla-insertblock block (vlax-3d-point p) dwg 1. 1. 1. 0.)
  40.       )
  41.     )
  42.   )
  43.   (princ)
  44. )

点评

清风明月10
比我上面那个强多了。 能帮我写一个将A.dwg中的“A4”布局复制到当前的DWG文档来的插件吗？因为该布局中有很多图元  发表于 2013-9-30 19:21

评分

参与人数 1D豆 +5 收起 理由
清风明月10 + 5 很给力!经验；技术要点；资料分享奖！

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

st788796

已领礼包: 1268个

财富等级: 财源广进
发表于 2013-9-30 19:51:46 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
布局到布局?图形是否打开?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

清风明月10
 楼主| 发表于 2013-9-30 19:54:49 | 显示全部楼层
没打开，只是提供路径例如：“D:\00邓细木CAD插件汇总\CAD每天使用的图形样板文件（尾缀dwt）Template文件夹\000000DXM每天新建CAD文件的模板.dwt”

点评

st788796
这个 CopyObjects 很少用，需要时在论坛搜个帖子，比照着写  详情 回复 发表于 2013-9-30 21:27
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

st788796

已领礼包: 1268个

财富等级: 财源广进
发表于 2013-9-30 21:27:05 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
清风明月10 发表于 2013-9-30 19:54
没打开，只是提供路径例如：“D:\00邓细木CAD插件汇总\CAD每天使用的图形样板文件（尾缀dwt）Template文件 ...

这个 CopyObjects 很少用，需要时在论坛搜个帖子，比照着写
  1. (defun c:tt (/ fl *acad* DBXDoc l itemps)
  2.   (if (setq fl (getfiled "Select DWG" "" "Dwg;Dwt" 8))
  3.     (progn
  4.       (setq *acad* (vlax-get-acad-object)
  5.      DBXDoc (vla-GetInterfaceObject
  6.        *acad*
  7.        (if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
  8.          "ObjectDBX.AxDbDocument"
  9.          (strcat "ObjectDBX.AxDbDocument." (itoa acVer))
  10.        )
  11.      )
  12.       )
  13.       (defun itemps (col / l)
  14. (vlax-for i col
  15.    (if (/= (vla-get-objectname i) "AcDbViewport")
  16.      (setq l (cons i l))
  17.    )
  18. )
  19. (reverse l)
  20.       )
  21.       (vla-open DBXDoc fl)
  22.       (vlax-invoke
  23. dbxdoc
  24. 'copyobjects
  25. (list (vla-item (vla-get-layouts dbxdoc) "布局1"))
  26. (vla-get-layouts
  27.    (vla-get-activedocument *acad*)
  28. )
  29.       ) ;_复制布局
  30.       (if (setq l (itemps (vla-get-paperspace dbxdoc)))
  31. (vlax-invoke
  32.    dbxdoc
  33.    'copyobjects
  34.    l
  35.    (vla-get-paperspace
  36.      (vla-get-activedocument *acad*)
  37.    )
  38. ) ;_复制图纸空间实体
  39.       )
  40.       (vlax-release-object dbxdoc)
  41.     )
  42.   )
  43.   (princ)
  44. )

评分

参与人数 1D豆 +5 收起 理由
清风明月10 + 5 有始有终奖！

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

清风明月10
 楼主| 发表于 2013-9-30 21:33:29 | 显示全部楼层

(defun c:导入布局剖面图3横深勘东莞 ()
;;;自己写的
  (COMMAND "LAYOUT" "T" "D:\\00CAD插件汇总\\CAD每天使用的图形样板文件（尾缀dwt）Template文件夹\\000钻孔剖面图所有布局深勘东莞DXM.dwt"  "剖面图3横深勘东莞")
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2025-9-28 08:30 , Processed in 0.206469 second(s), 52 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

快速回复 返回顶部 返回列表