[编程交流] 将实体压缩为块

(Defun C:test()
;Cleaning your variables
 (setq temp_ent_dxfgroup nil)
;Load vlax support
 (vl-load-com)
;Begin scriptiong
 (Setq window_id_cntr 0)
 (setq ent_test(car(entsel)))
 (setq ent_test(vlax-ename->vla-object ent_test))
 (setq ent_orientation (vlax-get-property ent_test 'angle))
 (setq ent_length (vlax-get-property ent_test 'length))
 (Setq ent_orientation(angtos ent_orientation 0))        ;Angle in degrees of first object
 (setq ent_orientation(atoi ent_orientation))
 (setq ent_start (vlax-curve-getStartPoint ent_test))        ;Get object start  point
 (if(or (= ent_orientation 0) (= ent_orientation 180))        ;Get orientation of the line horizontal or vertical
   (progn
           (setq  alignment "x")                    ;Use this to determine which axis to set range scope
       (setq static_val (cadr ent_start))
           (setq start_val (car ent_start))
         (if (= ent_orientation 0)
           (progn
             (setq param1 start_val)
                        (setq param2 (+ start_val ent_length))
             )
       )
       (if (= ent_orientation 180)
           (progn
             (setq param1 start_val)
                        (setq param2 (+ start_val ent_length))
             )
       )
   )
 )
 (if(or (= ent_orientation 90) (= ent_orientation 270))
    (progn
           (setq  alignment "y")
           (setq static_val (car ent_start))
           (setq start_val (cadr ent_start))
          (if (= ent_orientation 90)
             (progn
             (setq param1 start_val)
                        (setq param2 (+ start_val ent_length))
             )
         
       )
       (if (= ent_orientation 270)
             (progn
             (setq param1 start_val)
                        (setq param2 (+ start_val ent_length))
             )
       )
   )                                ; the first parameters have been derived now loop through 
 )                                    ; each of the remaining entites 
; first entity parameters defined create selection set and check points against definitions
 (Setq sset_ent (ssget "X"
           '(
             (-4 . "<OR")
             (-4 . "<AND")
             (8 . "Windows")
             (-4 . "AND>")
             (-4 . "<NOT")
             (0 . "INSERT")
             (-4 . "NOT>")
             (-4 . "OR>")
            )
            )
 )
(setq cntr 0)
(while (< cntr (sslength sset_ent))
      (setq temp_ent(ssname sset_ent cntr))
    (setq temp_ent_dxfgroup(entget temp_ent))
    (foreach c  temp_ent_dxfgroup
           (if (= 10 (car c))
                   (setq p_list
                 (append p_list
                 (list
                    (cdr c)
                     )
                )
            )
          )
      )
      (foreach c p_list
       (Setq x_point (car c))
         (Setq y_point(cadr c))
         (if (= alignment "x")
             (progn
                 (if (= y_point static_val)
                          (progn
                       (if (and (>= x_point param1)(<= x_point param2))
                            (alert "WORKING UPTO AND HERE")
                       )
                    )
               )
           )
       )
         (if (= alignment "y")
             (progn
                 (if (= x_point static_val)
                          (progn
                       (if (and (>= y_point param1)(<= y_point param2))
                            (alert "WORKING UPTO HERE")
                       )
                    )
               )
           )
       )
   )
   (Setq cntr (+ cntr 1))        ;exit while loop
)
 
)