[编程交流] 选择复制的对象

;Store the last database entity before copying objects
(setq Marker (entlast))
;Create a temporary selection set
(setq TempSelectionSet (ssadd))
;Preform commands
(command "copy" ...)
;Add all entities created after copy to the TempSelectionSet
(while
 (setq Marker (entnext Marker))
 (ssadd  Marker TempSelectionSet ))

;;; Copy Command and return selectionset
;;; Requires Express Tools' ACET-SS-Drag-Move subroutine
;;; Alan J. Thompson, 11.09.09
(defun AT:Copy (/ #SS #Pnt1 #Pnt2 #Pnts #SSAdd #Copy)
 (vl-load-com)
 (cond
   ((and (setq #SS (ssget "_:L"))
         (setq #Pnt1 (getpoint "\nSpecify base point: "))
         (setq #Pnt2 (acet-ss-drag-move #SS #Pnt1 "\nSpecify placement point: " T))
    ) ;_ and
    (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
    (setq #Pnts (mapcar '(lambda (x) (vlax-3d-point (trans x 1 0)))
                        (list #Pnt1 #Pnt2)
                ) ;_ mapcar
    ) ;_ setq
    (setq #SSAdd (ssadd))
    (vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*))
      (ssadd (vlax-vla-object->ename (setq #Copy (vla-copy x))) #SSAdd)
      (vla-move #Copy (car #Pnts) (cadr #Pnts))
    ) ;_ vlax-for
    (vl-catch-all-apply 'vla-delete (list #SS))
   ) ;_ cond
 ) ;_ cond
 #SSAdd
) ;_ defun

(defun c:Test (/ ss)
 (and (setq ss (AT:Copy))
      (command "_.change" ss "" "_p" "_c" 3 "")
 ) ;_ and
) ;_ defun

(defun C:TEST ( / ss )
 (setvar "CMDECHO" 1)
 ;;;Creat Marker
 (mip:mark)
 ;;;Preform commands
 (princ "\nSelect objects for copying... ")
 (setq ss (ssget "_:L"))
 (command "_COPY" ss "" "_M")
 (while (> (getvar "CMDACTIVE") 0)(command pause))
;;; Select all entities created after copy
 (setq ss (mip:get-last-ss))
;;; Change color new objects to red
 (if ss
   (command "_CHPROP" ss "" "_Color" 1 "")
   )
 (setq ss nil)
 (princ)
 )
(defun mip:mark ( )
 ;;;* Mark data base to allow KB:catch.
;;;* http://www.theswamp.org/index.php?topic=15863.0
(if (setq *mip:mark (entlast)) nil
   (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
      (setq *mip:mark (entlast))(entdel *mip:mark)))(princ))
;;;* returns selection set of entities since last mip:mark.
(defun mip:get-last-ss (/ ss tmp val)
(setq val (getvar "cmdecho"))(setvar "cmdecho" 0)
(if *mip:mark (progn (setq ss (ssadd))
(while (setq *mip:mark (entnext *mip:mark))(ssadd *mip:mark ss))
(command "._select" ss "")(setq tmp ss ss nil));_progn
(alert "*mip:mark not set. \n run (mip:mark) before mip:get-last-ss."));_if
(setvar "cmdecho" val) tmp)

;;  CAB 09.17.08 - get last entity of a type in datatbase
;;  An entity name, or nil, if there are no entities in the current drawing.
(defun GetLastEnt ( / ename result )
 (if (setq result (entlast))
   (while (setq ename (entnext result))
     (setq result ename)
   )
 )
 result
)
;;  CAB 09.17.08 - return a list of new enames
;;  if ename is nil then return all objects in DWG
(defun GetNewEntities (ename / new)
 (cond
   ((or (null ename) (null (setq new (list (entnext))))))
   ((eq 'ENAME (type ename))
     (while (setq ename (entnext ename))
       (if (entget ename) (setq new (cons ename new)))
     )
   )
   ;((alert "Ename wrong type."))
 )
 new
)