;|===========================================================================|
|  Çizim alanının belli bir bölgesini tanımlamak üzere belirlenen PoLyLine  |
|  içine move edilen objelerin Layer'larını ilgili PoLyLine'ın Layer'ına    |
|  çevirir. Reactor'leri devreden çıkarmak için cLr girilmelidir.           |
|         Hazırlayan: M. Şahin Güvercin  13/01/2012   www.autocadokulu.com  |
|___________________________________________________________________________|;
(write-line "Hazırlayan: M. Şahin Güvercin - www.autocadokulu.com")
;|===========================================================================|
|  *** Reactor Temizleme Fonksiyonu ***                                     |
|___________________________________________________________________________|;
(defun c:cLr () (mapcar 'vlr-remove-all '(:VLR-Object-reactor))
  (mapcar 'vlr-remove-all '(:vlr-command-reactor))
  (princ "\n >FaLcon Reactor< Kaldırıldı.")(prin1))
;|===========================================================================|
|  *** Command Reactor - commandWiLLStart Fonksiyonu ***                    |;
(defun WiLLStart (Tetikci TetikLenen /) (setq fLag nil))
;|===========================================================================|
|  *** Object Reactor Fonksiyonu ***                                        |
|___________________________________________________________________________|;
(defun ChToZnLyr (Tetikci TetikLenen eData /)
  (if Tetikci (setq PvT Tetikci fLag T)))
;|===========================================================================|
|  *** Command Reactor - commandEnded Fonksiyonu   ***                      |
|___________________________________________________________________________|;
(defun Ended (Tetikci TetikLenen / StPt xLn m BnD SoLNkt SagNkt)
  (if fLag (progn
      (vla-getboundingbox PvT 'StPt 'EnPt)
      (setq StPt (vlax-safearray->list StPt))
      (entmake (list '(0 . "XLine") '(100 . "AcDbEntity") '(100 . "AcDbXline")
                     (cons 10 StPt) '(11 1.0 0 0)))
      (setq xLn (vlax-ename->vla-object (entlast)) m (sslength BlgSnrObjlr))
      (while (> (setq m (1- m)) -1)
        (setq BnD (vlax-ename->vla-object (ssname BlgSnrObjlr m)))
        (if (not (vlax-erased-p BnD)) (progn
            (setq ints (vlax-variant-value (vla-intersectwith xLn BnD 0)))
            (if (> (vlax-safearray-get-u-bound ints 1) 2)
              (setq ints (vlax-safearray->list ints)) (setq ints nil))
            (if ints (progn (setq SoLNkt nil SagNkt nil o -3)
                (while (< (setq o (+ o 3)) (length ints))
                  (if (<= (nth o ints) (car StPt))
                    (setq SoLNkt T) (setq SagNkt T)))
                (if (and SoLNkt SagNkt) (progn
                  (vlax-put-property PvT 'Layer (vlax-get-property BnD 'Layer))
                    (setq fLag nil m 0) (princ ">FaLcon Reactor<"))
                  (progn (vlax-put-property PvT 'Layer (getvar "CLayer"))
                    (princ ">FaLcon Reactor<"))))))))
      (vla-erase xLn))))
;|===========================================================================|
|  *** Bölge Sınırlarını Belirleme ve Reactor atama (Ana Fonksiyon) ***     |
|___________________________________________________________________________|;
(defun c:FaLcon (/ *error* n Tetikciler)
  (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com)
  (defun *error* (er) (command "_.undo" "e") (princ (strcat "\n" er)))
  (princ "\nBölgeleri tanımlayan PoLyLine objelerini seçiniz: ")
  (setq BlgSnrObjlr (ssget (list '(0 . "LwPoLyLine") '(70 . 1)))
        TetikciLer  (ssget "x" (list '(-4 . "<NOT")     '(-4 . "<OR")
            '(0 . "3DSOLID")   '(0 . "REGION") '(0 . "SECTION")   '(0 . "MESH")
            '(-4 . "OR>")      '(-4 . "NOT>"))) n (sslength BlgSnrObjlr))
  (while (> (setq n (1- n)) -1) (ssdel (ssname BlgSnrObjlr n) TetikciLer))
  (setq n (sslength TetikciLer))
  (while (> (setq n (1- n)) -1)
    (vlr-object-reactor (list (vlax-ename->vla-object (ssname TetikciLer n)))
      "Layer Reactor" '((:vlr-modified . ChToZnLyr))))
  (vlr-command-reactor nil
    '((:vlr-commandwillstart . WillStart) (:vlr-commandEnded . Ended)))
  (command "_.undo" "e") (princ "\n >FaLcon Reactor< Etkin.") (prin1))
;|___________________________________________________________________________|;
(princ "\n*** >FaLcon Reactor< ü başlatmak için FaLcon      ***")
(princ "\n*** >FaLcon Reactor< den çıkmak için cLr giriniz. ***")(prin1)