;-----------------------------------------------------------------------------------;
;                                                                                   ;
;   CHECK4SQUARE.LSP by Michael Bulatovich  www.michaelbulatovich.ca                ;
;                                                                                   ;
;   Checks a selection set and finds all the items                                  ;
;   that are not square to the current UCS. Then gives you the options              ;
;   of highlighting, erasing, or changing them.No error handler-                    ;
;   and no warranties!                                                              ;
;                                                                                   ;
;   Revised to include fuzz factor. 21-11-02                                        ;
;-----------------------------------------------------------------------------------;

(defun C:check4square (/      ent        obj	   p1	  p2	 a
		       C1     sslen  squset notlin result act	 ss
		       minx   maxx   miny   maxy   frompt topt	 ztest
		       nolino setfuz 
		      )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;      INITIAL SECTION                      ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (not firstcheck)
    (progn
      (setq fuz 0.00000001)
      (setq firstcheck t)))
  (prompt    "Check4Square tests selected lines for orthogonality to the current UCS...")
  (initget  "Yes No")
    (setq setfuz (getkword
		   (strcat "\nDo you want to set the fuzz factor?\nCurrent setting is "
			   (rtos fuz 2 10)
			   ". Yes/<No>:")))
  (if (eq setfuz "Yes")
    (setq fuz (getreal
		 (strcat "\nSpecify minimum difference in values desired as a real number <"
			 (rtos fuz 2 10)
			 ">:"))))  
  (setvar "cmdecho" 0)
  (setq ss (ssget))
  (setq squset (ssadd))
  (setq notlin (ssadd))
  (SETQ C1 0)
  (SETQ SSLEN (SSLENGTH SS))
  (setq ztest nil)
  

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;      TESTING SECTION                      ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (WHILE (< C1 SSLEN)
    (SETQ ent (SSNAME SS c1))		; GET AN ITEM
    (SETQ obj (ENTGET ent))
    (if
      (equal (cdr (assoc 0 obj)) "LINE") ; IF THE OBJECT IS A LINE...
       (progn
	 (setq p1 (trans (cdr (assoc 10 obj)) 0 1)
	       p2 (trans (cdr (assoc 11 obj)) 0 1)
	       a  (angle p1 p2)
	 )				; SET UP THE POINTS AND ANGLE
	 (if
	   (not	(or (equal a (/ pi 2.0) fuz)
		    (equal a pi fuz)
		    (equal a (* pi 1.5) fuz)
		    (equal a 0 fuz)
		)
	   )				;IF LINE IS NOT ORTHOGONAL...
					; THEN...DO THE FOLLOWING:
	    (progn
	      (ssadd ent squset)	; ADD IT TO THE "SKEW SET"...
	      (if (not ztest)		; IF ITS THE FIRST SKEWED ITEM...
					; ESTABLISH INITIAL ZOOM POINTS...
		(progn
		  (if (< (car p1) (car p2))
		    (setq minx (car p1)
			  maxx (car p2)
		    )
		    (setq minx (car p2)
			  maxx (car p1)
		    )
		  )
		  (if (< (cadr p1) (cadr p2))
		    (setq miny (cadr p1)
			  maxy (cadr p2)
		    )
		    (setq miny (cadr p2)
			  maxy (cadr p1)
		    )
		  )
		  (setq ztest t)
		)			;END INITIAL SKEW PROGN
					; OTHERWISE ADJUST THE ZOOMPOINTS IF REQUIRED...
		(progn
		  (if (and (< (car p1) (car p2))
			   (< (car p1) minx)
		      )
		    (setq minx (car p1))
		  )
		  (if (and (< (car p2) (car p1))
			   (< (car p1) minx)
		      )
		    (setq minx (car p2))
		  )
		  (if (and (> (car p1) (car p2))
			   (> (car p1) maxx)
		      )
		    (setq maxx (car p1))
		  )
		  (if (and (> (car p2) (car p1))
			   (> (car p2) maxx)
		      )
		    (setq maxx (car p2))
		  )

		  (if (and (< (cadr p1) (cadr p2))
			   (< (cadr p1) miny)
		      )
		    (setq miny (cadr p1))
		  )
		  (if (and (< (cadr p2) (cadr p1))
			   (< (cadr p1) miny)
		      )
		    (setq miny (cadr p2))
		  )
		  (if (and (> (cadr p1) (cadr p2))
			   (> (cadr p1) maxy)
		      )
		    (setq maxy (cadr p1))
		  )
		  (if (and (> (cadr p2) (cadr p1))
			   (> (cadr p2) maxy)
		      )
		    (setq maxy (cadr p2))
		  )


		)			; END ZOOM ADJUST PROGN

	      )				; END ZTEST PROGN
	    )				; END PROGN STARTED BY A FOUND SKEW


	 )				; END SQUARE TEST IF

       )				; END OF THE LINE TEST PROGN
       (ssadd ent notlin)		; IF THE OBJECT IS NOT A LINE, ADD IT TO THE NOTLIN SET
    )					; END OF THE LINE TEST
    (setq C1 (1+ C1))			; BUMP THE COUNTER
  )					; END OF WHILE


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
					;    REPORTING SECTION                      ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq result (itoa (sslength squset)))
  (setq nolino (itoa (sslength notlin)))
  (prompt (strcat "\n"
		  nolino
		  " object(s) selected was(were) not lines."
		  "\n"
		  result
		  " skewed line(s) found."
		 )
  )
  (setq frompt (list minx miny))	; SET ZOOM POINTS
  (setq topt (list maxx maxy))

  (if (not (equal result "0"))		; IF SKEWS WERE FOUND...
    (progn
      (initget 0 "View Erase Change")
      (setq act
	     (getkword
	       "...What do you want to do? \n<V>iew skewed objects \n<E>rase skewed objects
               \n<C>hange skewed object properties:"
	     )
      )
      (cond ((= act "View")
	     (progn
	       (command "undo" "be")
	       (command "zoom" frompt topt)
	       (command "zoom" ".8x")
	       (command "select" squset pause)
	       (command "undo" "end")
	     )
	    )
	    ((= act "Erase") (command "erase" squset ""))
	    ((= act "Change") (command "change" squset "" "p"))
      )
    )
  )

  (princ)
)