1. ;;--------------------=={ Chain Selection }==-----------------;;
    2. ;;                                                            ;;
    3. ;;  Prompts the user to select an object and generates a      ;;
    4. ;;  selection chain of all objects sharing endpoints with     ;;
    5. ;;  objects in the accumulative selection.                    ;;
    6. ;;------------------------------------------------------------;;
    7. ;;  Author: Lee Mac, Copyright ?2012 - www.lee-mac.com       ;;
    8. ;;------------------------------------------------------------;;
    10. (defun c:cs ( / en fl in l1 l2 s1 s2 sf vl )
    11.     (setq sf
    12.         (list
    13.            '(-4 . "<OR")
    14.                '(0 . "LINE,ARC")
    15.                '(-4 . "<AND")
    16.                    '(0 . "LWPOLYLINE,SPLINE")
    17.                    '(-4 . "<NOT")
    18.                        '(-4 . "&=")
    19.                        '(70 . 1)
    20.                    '(-4 . "NOT>")
    21.                '(-4 . "AND>")
    22.                '(-4 . "<AND")
    23.                    '(0 . "POLYLINE")
    24.                    '(-4 . "<NOT")
    25.                        '(-4 . "&")
    26.                        '(70 . 89)
    27.                    '(-4 . "NOT>")
    28.                    '(-4 . "AND>")
    29.                '(-4 . "<AND")
    30.                    '(0 . "ELLIPSE")
    31.                    '(-4 . "<OR")
    32.                        '(-4 . "<>")
    33.                        '(41 . 0.0)
    34.                        '(-4 . "<>")
    35.                         (cons 42 (+ pi pi))
    36.                    '(-4 . "OR>")
    37.                '(-4 . "AND>")
    38.            '(-4 . "OR>")
    39.             (if (= 1 (getvar 'cvport))
    40.                 (cons 410 (getvar 'ctab))
    41.                '(410 . "Model")
    42.             )
    43.         )
    44.     )
    45.     (if (setq s1 (ssget "_X" sf))
    46.         (if (setq en (ssget "_+.:E:S" sf))
    47.             (progn
    48.                 (setq s2 (ssadd)
    49.                       en (ssname en 0)
    50.                       l1 (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en))
    51.                 )
    52.                 (repeat (setq in (sslength s1))
    53.                     (setq en (ssname s1 (setq in (1- in)))
    54.                           vl (cons (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en) en) vl)
    55.                     )
    56.                 )
    57.                 (while
    58.                     (progn
    59.                         (foreach v vl
    60.                             (if (vl-some '(lambda ( p ) (or (equal (car v) p 1e-8) (equal (cadr v) p 1e-8))) l1)
    61.                                 (setq s2 (ssadd (caddr v) s2)
    62.                                       l1 (vl-list* (car v) (cadr v) l1)
    63.                                       fl t
    64.                                 )
    65.                                 (setq l2 (cons v l2))
    66.                             )
    67.                         )
    68.                         fl
    69.                     )
    70.                     (setq vl l2 l2 nil fl nil)
    71.                 )
    72.             )
    73.         )
    74.         (princ "\nNo valid objects found.")
    75.     )
    76.     (sssetfirst nil s2)
    77.     (princ)
    78. )
    79. (vl-load-com) (princ)