[编程交流] Lisp识别采购订单中的变更

(defun c:rpoli()
     (setq spoli (car (entsel "\nSelec. poligono. ")))
     (setq bpoli (entget spoli))
     (setq poli1 spoli) 
     (setq c (cdr (assoc 10 bpoli)))
     (while (/= "SEQEND" (cdr (assoc '0 bpoli)))
            (setq vert (cdr (assoc 10 bpoli)))
        (command "circle" vert "0.5")
            (setq spoli  (entnext spoli) bpoli (entget spoli))
      );wh
)

(defun c:dpoli()
     (setq spoli (car (entsel "\nSelec. poligono. ")))
     (setq bpoli (entget spoli))
     (setq poli2 poli1)
     (setq bpoli2 (entget poli2))
     (setq c (cdr (assoc 10 bpoli)))
     (while (/= "SEQEND" (cdr (assoc '0 bpoli)))
            (setq vert (cdr (assoc 10 bpoli)))
            (setq vert1 (cdr (assoc 10 bpoli2)))
            (setq p (car vert))
            (setq p1 (car vert1))
            (if (/= p p1)
                (progn
                (command "text" pause "1.5" "90" (car vert))
                (command "text" pause "1.5" "90" (cadr vert))
                )
            )                  
            (setq spoli  (entnext spoli))
            (setq poli2  (entnext poli2) bpoli (entget spoli) bpoli2 (entget poli2))
     );wh
)
(princ "\n Iniciar Rutina que recorre un pol�*gono:rpoli")

(defun c:PolyChange nil
 (vl-load-com)
 ;; © Lee Mac 2010
 (  (lambda ( data mod can / react objLst )
      (if (setq react
            (vl-some
              (function
                (lambda ( reactor )
                  (if (eq data (vlr-data reactor)) reactor)
                )
              )
              (cdar
                (vlr-reactors :vlr-object-reactor)
              )
            )
          )
        (if (vlr-added-p react)
          (progn
            (vlr-remove react)
            (setq *PolyData* nil)
          )
          (vlr-add react)
        )
        (setq react
          (vlr-object-reactor
            (progn
              (setq *PolyData*
                (mapcar
                  (function
                    (lambda ( obj )
                      (cons (vla-get-Handle obj)
                        (LM:Variant->2DPoints
                          (vla-get-Coordinates obj)
                        )
                      )
                    )
                  )
                  (setq objLst
                    (LM:ss->vla
                      (ssget "_:L" '((0 . "LWPOLYLINE")))
                    )
                  )
                )
              )
              objLst
            )
            data
            (list
              (cons :vlr-modified  mod)
              (cons :vlr-cancelled can)
            )
          )
        )
      )
      (princ
        (if (vlr-added-p react)
          "\n** Reactor Activated **"
          "\n** Reactor Deactivated **"
        )
      )
      react
    )
   "Example-Reactor"
   'PolyChange-Mod
   'PolyChange-Can
 )
 (princ)
)
(defun PolyChange-Mod ( object reactor args / points verts hand )
 (vl-load-com)
 
 (if *CommandisCancelled*
   (setq *CommandisCancelled* nil)    
   
   (if (and (not (vlax-erased-p object))
            (setq points (cdr (assoc (setq hand (vla-get-Handle object)) *PolyData*))))
     (progn      
       (mapcar
         (function
           (lambda ( p q )
             (or (equal p q 1e-6)
               (entmakex (list (cons 0 "POINT") (cons 10 p)))
             )
           )
         )
         (setq verts (LM:Variant->2DPoints (vla-get-Coordinates object)))
         points
       )
       (setq *PolyData*
         (subst (cons hand verts) (assoc hand *PolyData*) *PolyData*)
       )
     )
   )
 )
 (princ)
)
     
(defun PolyChange-Can ( object reactor args )
 (setq *CommandisCancelled* t)
 (princ)
)
;;-------------------=={ Variant Value }==--------------------;;
;;                                                            ;;
;;  Converts a VLA Variant into native AutoLISP data types    ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  value - VLA Variant to process                            ;;
;;------------------------------------------------------------;;
;;  Returns:  Data contained within variant                   ;;
;;------------------------------------------------------------;;
(defun LM:VariantValue ( value )
 ;; © Lee Mac 2010
 (cond
   ( (eq 'variant (type value))
     (LM:VariantValue (vlax-variant-value value))
   )
   ( (eq 'safearray (type value))
     (mapcar 'LM:VariantValue (vlax-safearray->list value))
   )
   ( value )
 )
)
;;-----------------=={ Group by Number }==--------------------;;
;;                                                            ;;
;;  Groups a list into a list of lists, each of length 'n'    ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  l - List to process                                       ;;
;;  n - Number of elements by which to group                  ;;
;;------------------------------------------------------------;;
;;  Returns:  List of lists, each of length 'n'               ;;
;;------------------------------------------------------------;;
(defun LM:GroupByNum ( l n / a b )
 ;; © Lee Mac 2010
 (while l
   (
     (lambda ( i )
       (while (< 0 i)
         (setq a (cons (car l) a) l (cdr l) i (1- i))
       )
       (setq b (cons (reverse a) b) a nil)
     )
     n
   )
 )
 (reverse b)
)
;;----------------=={ Variant->2DPoints }==-------------------;;
;;                                                            ;;
;;  Converts a Variant of Double type to a list of 2D Points  ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  var - VLA Variant                                         ;;
;;------------------------------------------------------------;;
;;  Returns:  List of 2D Points                               ;;
;;------------------------------------------------------------;;
(defun LM:Variant->2DPoints ( var )
 ;; © Lee Mac 2010
 (LM:GroupByNum (LM:VariantValue var) 2)
)
;;-----------------=={ SelectionSet -> VLA }==----------------;;
;;                                                            ;;
;;  Converts a SelectionSet to a list of VLA Objects          ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  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
   )
 )
)