[编程交流] Crossing Line Selction & Break

;;; ------------------------------------------------------------------------;;;    SelectEverythingTouching.lsp v1.0;;;;;;    Copyright© 03.06.10;;;    Alan J. Thompson (alanjt);;;;;;    Permission to use, copy, modify, and distribute this software;;;    for any purpose and without fee is hereby granted, provided;;;    that the above copyright notice appears in all copies and;;;    that both that copyright notice and the limited warranty and;;;    restricted rights notice below appear in all supporting;;;    documentation.;;;;;;    The following program(s) are provided "as is" and with all faults.;;;    Alan J. Thompson DOES NOT warrant that the operation of the program(s);;;    will be uninterrupted and/or error free.;;;;;;    Allows user to select all object(s) touching selected object(s).;;;;;;    Revision History:;;;;;; ------------------------------------------------------------------------(defun c:SET (/) (c:SelectEverythingTouching))(defun c:SelectEverythingTouching (/ *error* #SS #P1 #P2 #Temp #Add #Num);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SUBROUTINES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; error handler (defun *error* (#Message)   (and #Message        (not (wcmatch (strcase #Message) "*BREAK*,*CANCEL*,*QUIT*"))        (princ (strcat "\nError: " #Message))   ) ;_ and ) ;_ defun;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ROUTINE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (vl-load-com) (cond   ((setq #SS (ssget))    (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))    (setq #Add (ssadd))    (vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*))      (vla-getboundingbox x '#P1 '#P2)      (setq #P1 (vlax-safearray->list #P1)            #P2 (vlax-safearray->list #P2)      ) ;_ setq      (and (setq #Temp (ssget "_C"                              (trans (list (car #P1) (cadr #P2) 0.) 0 1)                              (trans (list (car #P2) (cadr #P1) 0.) 0 1)                       ) ;_ ssget           ) ;_ setq           (repeat (setq #Num (sslength #Temp))             (if (vlax-invoke                   x                   'IntersectWith                   (vlax-ename->vla-object (ssname #Temp (setq #Num (1- #Num))))                   acExtendNone                 ) ;_ vlax-invoke               (ssadd (ssname #Temp #Num) #Add)               T             ) ;_ if           ) ;_ repeat           (ssadd (vlax-vla-object->ename x) #Add)      ) ;_ and    ) ;_ vlax-for    (vla-delete #SS)    (sssetfirst nil #Add)   ) ) ;_ cond (princ)) ;_ defun