[编程交流] 快速检查

(defun c:FOO  (/ ss)
 (vl-load-com)
 (if (setq ss (ssget '((0 . "LINE,*POLYLINE"))))
   ((lambda (i / e l)
      (while (setq e (ssname ss (setq i (1+ i))))
        (setq l
               (cons
                 (cons e
                       (list
                         (vlax-curve-getstartpoint e)
                         (vlax-curve-getendpoint e)))
                 l)))
      (foreach a l
        [color=red];; ... Rest of code goes here
[/color]        ))
     -1))
 (princ))

;;-----------------------------------------------
;; SSGETENDS.LSP (c)2002, John F. Uhden, Cadlantic
;; Function to create a selection set of Lines
;; within a fuzz distance of either end of a Line
;; given the 'ENAME of the selected line and the
;; fuzz distance as a real or integer.
;; Dedicated to Bill Zondlo c.02-04-02
;;
(defun ssgetends (e fuzz / ent p10 p11 ss)
 (and
   (= (type e) 'ENAME)
   (numberp fuzz)
   (>= fuzz 0)
   (setq ent (entget e))
   (= (cdr (assoc 0 ent)) "LINE")
   (setq p10 (cdr (assoc 10 ent)))
   (setq p11 (cdr (assoc 11 ent)))
   (setq fuzz (list fuzz fuzz fuzz))
   (setq ss
     (ssget "X"
       (list
        '(0 . "LINE")
        '(-4 . "<OR")
          '(-4 . "<AND")
            '(-4 . ">=,>=,>=")
             (cons 10 (mapcar '- p10 fuzz))
            '(-4 . "<=,<=,<=")
             (cons 10 (mapcar '+ p10 fuzz))
          '(-4 . "AND>")
          '(-4 . "<AND")
            '(-4 . ">=,>=,>=")
             (cons 10 (mapcar '- p11 fuzz))
            '(-4 . "<=,<=,<=")
             (cons 10 (mapcar '+ p11 fuzz))
          '(-4 . "AND>")
          '(-4 . "<AND")
            '(-4 . ">=,>=,>=")
             (cons 11 (mapcar '- p10 fuzz))
            '(-4 . "<=,<=,<=")
             (cons 11 (mapcar '+ p10 fuzz))
          '(-4 . "AND>")
          '(-4 . "<AND")
            '(-4 . ">=,>=,>=")
             (cons 11 (mapcar '- p11 fuzz))
            '(-4 . "<=,<=,<=")
             (cons 11 (mapcar '+ p11 fuzz))
          '(-4 . "AND>")
        '(-4 . "OR>")
       )
     )

(defun c:SN (/ e1 e2)
 (if (and (setq e1 (entsel "\nSelect first object: "))
          (setq e2 (entsel "\nSelect second object: "))
     )
   (if (apply (function (lambda (a b) (equal a b 0.)))
              (mapcar (function (lambda (e)
                                  (cond ((osnap (cadr e) "_END"))
                                        ((cdr (assoc 10 (entget (car e)))))
                                  )
                                )
                      )
                      (list e1 e2)
              )
       )
     (alert "Objects snap.")
     (alert "Objects do not snap!")
   )
 )
 (princ)
)