;1. dokonaa selekcji poligonalnej, obiekty musz1 sie w ca3o?ci mie?cia w oknie
;2. pozostawia tylko te, których sumaryczne pole >460
;3. dodaa warstwe "wynik" i przenie?a na ni1 selekcje
;4. wy31czya pozosta3e warstwy

;1. Create a polygonal selection. The selected objects have to be completly inside the selection
;2. Leave only those, whose total area is > 460
;3. Add a layer "result" and move the selection to it
;4. Disable/hide the other layers

(setq application (vlax-get-acad-object))
(setq active_document (vla-get-activedocument application))
(setq document_blocks (vla-get-Blocks active_document))
(setq layers (vla-get-layers active_document))

(defun uniq (lst / out)
  (while lst
    (setq out (cons (car lst) out))
    (setq lst (vl-remove (car lst) (cdr lst))))
  (reverse out))

(defun ConvList_to_VariantArray (InList SAType / LengthList i iList)
    (setq LengthList (length InList))
    (setq OutSaveArray (vlax-make-safearray SAType (cons 0 (1- LengthList))))
    (setq i 0)
    (repeat LengthList
        (setq iList (nth i InList))
        (vlax-safearray-put-element OutSaveArray i iList)
        (setq i (1+ i)))
  (vlax-make-variant OutSaveArray))

(defun get_model_space ( / application active_document)
  (setq application (vlax-get-acad-object))
  (setq active_document (vla-get-activedocument application))
  (vlax-get-property active_document 'ModelSpace))

(defun get_model_space_objects ()
  (object_to_list (get_model_space)))

(defun id_to_object (object_id / application active_document)
  (setq application (vlax-get-acad-object))
  (setq active_document (vla-get-activedocument application))
  (vla-ObjectIDToObject active_document object_id))

(defun get_points (num_points / points_list)
  (setq points_list nil)
  (repeat num_points
    (setq points_list
      (append points_list (getpoint))))
  points_list)

(defun create_selection ( / application active_document selection_sets)
  (setq application (vlax-get-acad-object))
  (setq active_document (vla-get-activedocument application))
  (setq selection_sets (vla-get-SelectionSets active_document))
  ;(vla-Add selection_sets "SelAll2")    ;uncomment if needed
  (vla-item selection_sets "SelAll2"))

(defun add_polygon_to_selection (sel sel_points / filter_type filter_data)
  (setq filter_type (ConvList_to_VariantArray (list 8) vlax-vbInteger))
  (setq filter_data (ConvList_to_VariantArray (list (vlax-make-variant "0")) vlax-vbVariant))
  (vla-clear sel)
  (vla-SelectByPolygon sel acSelectionSetWindowPolygon
    (ConvList_to_VariantArray sel_points vlax-vbDouble) filter_type filter_data))

(defun object_to_list (object / result)
  (setq result nil)
  (vlax-for element object
    (setq result (append result (list element))))
  result)

(defun get_named_block (block_name)
  (vla-item document_blocks block_name))

(defun get_shape_area (object)
  (if (vlax-property-available-p object 'Area)
    (vla-get-area object)
    0.0))

(defun sum_list (list / sum)
  (setq sum 0)
  (foreach x list
    (setq sum (+ sum x)))
  sum)

(defun get_block_area (block / areas shapes)
  (setq area 0)
  (setq shapes (object_to_list block))
  (setq areas (mapcar 'get_shape_area shapes))
  (sum_list areas))

(defun block_predicate (block / area)
  (setq area (get_block_area block))
  (< area 460))

(defun get_valid_blocks ()
  (setq sel_points (get_points 4))
  (setq selection (create_selection))
  (add_polygon_to_selection selection sel_points)
  (setq selected_references (object_to_list selection))
  (setq selected_block_names (mapcar 'vla-get-effectivename selected_references))
  (setq selected_block_names (uniq selected_block_names))
  (setq selected_blocks (mapcar 'get_named_block selected_block_names))
  (vl-remove-if 'block_predicate selected_blocks))

(defun hide_all_layers ()
  (vlax-for layer layers
    (vla-put-layeron layer :vlax-false)))

(defun create_layer (layer_name)
  (vla-add layers layer_name)
  (vla-item layers layer_name))

(defun move_reference_to_layer (object layer_name)
  (vla-put-layer object layer_name))


;(foreach block selected_blocks
;  (setq area (get_block_area block))
;  (print block)
;  (print area))

(setq valid_blocks (get_valid_blocks))
(setq valid_block_names (mapcar 'vla-get-name valid_blocks))

(hide_all_layers)
(create_layer "result")

(foreach reference selected_references
  (setq name (vla-get-effectivename reference))
  (if (member name valid_block_names)
    (move_reference_to_layer reference "result")))

(print "wheee")