从其他图纸插入块
大家好，我想用这个lisp来插入块，但我想用另一种方式——我想在我的工具栏上做一个图标，你的lisp和dcl一起工作。我不需要这个dcl，我想做一个宏。。。你能帮我吗？这就是我说的例行公事。。。
谢谢
;;----------------------=={ Copy Block }==--------------------;;
;; ;;
;;Copies the specified block definition from the specified;;
;;filename to the ActiveDocument using a deep clone ;;
;;operation (Method inspired by Tony Tanzillo) ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;block - string specifying block name to copy ;;
;;filename - filename of drawing from which to copy block ;;
;;------------------------------------------------------------;;
;;Returns: Block definition in ActiveDocument, else nil ;;
;;------------------------------------------------------------;;
(defun LM:CopyBlock ( block filename / acapp acdoc acblk acdocs dbxDoc item )
(vl-load-com)
;; © Lee Mac 2010
(setq acapp (vlax-get-acad-object)
acdoc (vla-get-ActiveDocument acapp)
acblk (vla-get-Blocks acdoc))
(vlax-map-collection (vla-get-Documents acapp)
(function
(lambda ( doc )
(setq acdocs
(cons
(cons (strcase (vla-get-fullname doc)) doc) acdocs
)
)
)
)
)
(if
(and
(not (LM:Itemp acblk block))
(setq filename (findfile filename))
(not (eq filename (vla-get-fullname acdoc)))
(or
(setq dbxDoc (cdr (assoc (strcase filename) acdocs)))
(progn
(setq dbxDoc (LM:ObjectDBXDocument))
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-open (list dbxDoc filename))
)
)
)
)
(setq item (LM:Itemp (vla-get-Blocks dbxDoc) block))
)
(vla-CopyObjects dbxDoc
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbObject '(0 . 0)) (list item)
)
)
acblk
)
)
(and dbxDoc (vlax-release-object dbxDoc))
(LM:Itemp acblk block)
)
;;-----------------=={ ObjectDBX Document }==-----------------;;
;; ;;
;;Retrieves a version specific ObjectDBX Document object ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: - None - ;;
;;------------------------------------------------------------;;
;;Returns:VLA ObjectDBX Document object, else nil ;;
;;------------------------------------------------------------;;
(defun LM:ObjectDBXDocument ( / acVer )
;; © Lee Mac 2010
(vla-GetInterfaceObject (vlax-get-acad-object)
(if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
"ObjectDBX.AxDbDocument"
(strcat "ObjectDBX.AxDbDocument." (itoa acVer))
)
)
)
;;-----------------------=={ Itemp }==------------------------;;
;; ;;
;;Retrieves the item with index 'item' if present in the ;;
;;specified collection, else nil ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;coll - the VLA Collection Object ;;
;;item - the index of the item to be retrieved ;;
;;------------------------------------------------------------;;
;;Returns:the VLA Object at the specified index, else nil ;;
;;------------------------------------------------------------;;
(defun LM:Itemp ( coll item )
;; © Lee Mac 2010
(if
(not
(vl-catch-all-error-p
(setq item
(vl-catch-all-apply
(function vla-item) (list coll item)
)
)
)
)
item
)
)
;;Test Function
(defun c:instbl ( / *error* doc blk dwg pt norm )
(vl-load-com)
;; © Lee Mac 2010
(defun *error* ( msg )
(and dbxDoc (vlax-release-object dbxDoc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(if (and
(setq blk (getstring t "\nSpecify Name of Block to Copy: "))
(setq dwg (getfiled "Select Drawing to Copy From" "" "dwg" 16))
(LM:CopyBlock blk dwg)
(setq pt(getpoint "\nPick Point for Block: "))
)
(progn
(setq norm (trans '(0. 0. 1.) 1 0 t))
(vla-insertBlock
(if
(or
(eq AcModelSpace
(vla-get-ActiveSpace
(setq doc
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
)
)
(eq :vlax-true (vla-get-MSpace doc))
)
(vla-get-ModelSpace doc)
(vla-get-PaperSpace doc)
)
(vlax-3D-point (trans pt 1 0)) blk 1. 1. 1.
(angle '(0. 0. 0.) (trans (getvar 'UCSXDIR) 0 norm t))
)
)
)
(princ)
)
insblk2.lsp
insblk2.dcl 工具选项板对此很好（不需要lisp）？
克鲁格 嗨，弗洛波，
我正在为我的网站更新代码，应该很快就会出现。
编辑：此处：http://lee-mac.com/copyblockfromdrawing.html--尽管此版本使用对话框。
同时，您可以使用宏调用代码，因此：
^C^C(LM:CopyBlock "BlockName" "C:\\MyDrawing.dwg")
页:
[1]