[编程交流] 给那些无聊的人一个主意

 
;;-------------------=={ Copy to Drawing }==------------------;;
;;                                                            ;;
;;  Enables a user to copy a SelectionSet of objects to a     ;;
;;  selected drawing. Layout on which objects reside will be  ;;
;;  created if non-existent.                                  ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - [url="http://www.lee-mac.com/"]www.lee-mac.com[/url]       ;;
;;------------------------------------------------------------;;
(defun c:C2DWG nil (c:CopytoDrawing))
(defun c:CopytoDrawing ( / *error* _StartUndo _EndUndo ac dbx doc dwgs dwg ss [b][color=sienna]XrPath[/color][/b])
 ;; © Lee Mac 2010
 (vl-load-com)
 (defun *error* ( msg )
   (LM:ReleaseObject dbx) (if doc (_EndUndo doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )
 (defun _StartUndo ( doc ) (_EndUndo doc)
   (vla-StartUndoMark doc)
 )
 (defun _EndUndo ( doc )
   (if (= 8 (logand 8 (getvar 'UNDOCTL)))
     (vla-EndUndoMark doc)
   )
 )
 (setq doc (vla-get-ActiveDocument (setq ac (vlax-get-acad-object))))
 (vlax-map-collection (vla-get-Documents ac)
  '(lambda ( d )
     (setq dwgs (cons (cons (strcase (vla-get-fullname d)) d) dwgs))
   )
 )
 (if (and (setq ss  (ssget (list (cons 410 (setq tab (getvar 'CTAB))))))
[b][color=sienna]   ; Next, getfiled, will return the destination file including path.[/color][/b]
[b][color=sienna]   ; I turn this part off first.[/color][/b]
[b][color=sienna]          ; (setq dwg (getfiled "Select Drawing to Copy to" "" "dwg" 16))[/color][/b]
[b][color=sienna]   ; Now, how to retrieve the xref's name and path?[/color][/b]
[b][color=sienna]   ; See the SubFunction below, it returns the Xref name and path[/color][/b]
[b][color=sienna]   (GetXrefPath)[/color][/b]
[b][color=sienna]   ; Put the content of variable XrPath into the variable dwg[/color][/b]
[b][color=sienna]   (setq dwg XrPath)[/color][/b]
[b][color=sienna]   ; I remember: localise dwg and / or XrPath, see above in main function[/color][/b]
   );_and
   (progn
     (_StartUndo doc)
     (if (setq dbx (cond ( (cdr (assoc (strcase dwg) dwgs)) )
                         ( (not (vl-catch-all-error-p
                                  (vl-catch-all-apply 'vla-open
                                    (list (setq dbx (LM:ObjectDBXDocument)) dwg)))) dbx)))
       (progn
         (LM:CopyObjects (LM:ss->vla ss) doc (vla-get-Block (cond ( (LM:Itemp (vla-get-layouts dbx) tab) )
                                                                  ( (vla-add  (vla-get-layouts dbx) tab) ))))
         (vla-saveas dbx dwg)
       )
     )
     (_EndUndo doc)
   )
 )
   (LM:ReleaseObject dbx)
[b][color=sienna] ; To make shure the right Xref is reloaded I use this, I have no better idea[/color][/b]
[b][color=sienna] ; First what is NOT working, reload only the selected Xref:[/color][/b]
[b][color=sienna] ; (vl-cmdf "_.xref" "_reload" dwg); WHY NOT ??[/color][/b]
[b][color=sienna] ; This does work however:[/color][/b]
[b][color=sienna] (vl-cmdf "_.xref" "_reload" "*")[/color][/b]
[b][color=sienna] ; Takes a little more time, that shouldn't be[/color][/b]
 (princ)
)
;;-----------------=={ ObjectDBX Document }==-----------------;;
;;                                                            ;;
;;  Retrieves a version specific ObjectDBX Document object    ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - [url="http://www.lee-mac.com/"]www.lee-mac.com[/url]       ;;
;;------------------------------------------------------------;;
;;  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))
   )
 )
)
;;------------------=={ Release Object }==--------------------;;
;;                                                            ;;
;;  Releases a VLA Object from memory via plentiful error     ;;
;;  trapping                                                  ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - [url="http://www.lee-mac.com/"]www.lee-mac.com[/url]       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  obj - VLA Object to be released from memory               ;;
;;------------------------------------------------------------;;
;;  Returns:  T if Object Released, else nil                  ;;
;;------------------------------------------------------------;;
(defun LM:ReleaseObject ( obj ) (vl-load-com)
 ;; © Lee Mac 2010
 (and obj (eq 'VLA-OBJECT (type obj)) (not (vlax-object-released-p obj))
   (not
     (vl-catch-all-error-p
       (vl-catch-all-apply
         (function vlax-release-object) (list obj)
       )
     )
   )
 )
)
;;--------------------=={ Copy Objects }==--------------------;;
;;                                                            ;;
;;  Applies a deep-clone copy to a list of objects            ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - [url="http://www.lee-mac.com/"]www.lee-mac.com[/url]       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  lst   - List of Objects to Copy                           ;;
;;  owner - Owner of Objects in List                          ;;
;;  dest  - Destination for Copied Objects                    ;;
;;------------------------------------------------------------;;
;;  Returns:  Array of Copied Objects                         ;;
;;------------------------------------------------------------;;
(defun LM:CopyObjects ( lst owner dest )
 ;; © Lee Mac 2010
 (vla-CopyObjects owner (LM:ObjectVariant lst) dest)
)
;;-------------------=={ Object Variant }==-------------------;;
;;                                                            ;;
;;  Creates a populated Object Variant                        ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - [url="http://www.lee-mac.com/"]www.lee-mac.com[/url]       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  lst - list of VLA Objects to populate the Variant.        ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Object Variant                              ;;
;;------------------------------------------------------------;;
(defun LM:ObjectVariant ( lst )
 ;; © Lee Mac 2010
 (LM:SafearrayVariant vlax-vbobject lst)
)
;;------------------=={ Safearray Variant }==-----------------;;
;;                                                            ;;
;;  Creates a populated Safearray Variant of a specified      ;;
;;  data type                                                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - [url="http://www.lee-mac.com/"]www.lee-mac.com[/url]       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  datatype - variant type enum (eg vlax-vbDouble)           ;;
;;  data     - list of static type data                       ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Variant Object of type specified            ;;
;;------------------------------------------------------------;;
(defun LM:SafearrayVariant ( datatype data )
 ;; © Lee Mac 2010
 (vlax-make-variant
   (vlax-safearray-fill
     (vlax-make-safearray datatype
       (cons 0 (1- (length data)))
     )
     data
   )    
 )
)
;;-----------------=={ SelectionSet -> VLA }==----------------;;
;;                                                            ;;
;;  Converts a SelectionSet to a list of VLA Objects          ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - [url="http://www.lee-mac.com/"]www.lee-mac.com[/url]       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  ss - Valid SelectionSet (Pickset)                         ;;
;;------------------------------------------------------------;;
;;  Returns:  List of VLA Objects                             ;;
;;------------------------------------------------------------;;
(defun LM:ss->vla ( ss )
 ;; © Lee Mac 2010
 (if ss
   (
     (lambda ( i / e l )
       (while (setq e (ssname ss (setq i (1+ i))))
         (setq l (cons (vlax-ename->vla-object e) l))
       )
       l
     )
     -1
   )
 )
)
;;-----------------------=={ Itemp }==------------------------;;
;;                                                            ;;
;;  Retrieves the item with index 'item' if present in the    ;;
;;  specified collection, else nil                            ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - [url="http://www.lee-mac.com/"]www.lee-mac.com[/url]       ;;
;;------------------------------------------------------------;;
;;  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
 )
)
[color=sienna][b]; My addition to retrieve the xref's path and name[/b][/color]
[color=sienna][b](defun GetXrefPath ( / XrFile );XrPath)[/b][/color]
[color=sienna][b] (setq XrFile  (car (entsel "\nSelect external reference to copy the objects to: "))[/b][/color]
[color=sienna][b]XrFile  (vlax-ename->vla-object XrFile)[/b][/color]
[color=sienna][b]XrPath   (vla-get-path XrFile)[/b][/color]
[color=sienna][b] );_setq[/b][/color]
 (princ)
) ;_defun
;|«Visual LISP© Format Options»
(120 2 1 2 nil "Ende von " 100 9 0 0 0 T T nil T)
;*** DO NOT add text below the comment! ***|;