;;Begin Lisp...
; orthoize.lsp
; d. philip
; 98.06.22
;Modified by Igal Averbuh 2015 (added option to set tolerance angle by two points on drawing)
;=================================================================
;
; Straighten selected line entities within given angle range.
; as written, this func will keep the line's midpoint in the same spot approx.
;
;
(defun c:ort ( / svcmde -_rang -_ss-x -_ss-u -_slen -_indx
-_entn -_enty -_pnt1 -_pnt2 -_ang1 -_dist
-_mid1 -_ang2 -_pnta -_pntb )

(setq svcmde (getvar "CMDECHO"))
(setvar "CMDECHO" 0)

(initget 1)
(setq -_rang (getdist "\nEnter tolerance angle by two points: "))

(setq -_ss-x (ssget "X" (list (cons 0 "LINE"))))
(prompt "\nSelect lines to straighten: ")
(setq -_ss-u (ssget (list (cons 0 "LINE"))))

(setq -_slen (sslength -_ss-u)
-_indx 0
)
(repeat -_slen
(setq -_entn (ssname -_ss-u -_indx)
-_enty (entget -_entn)
-_indx (1+ -_indx)
)
(if (ssmemb -_entn -_ss-x) ; if entity is a line [member of -_ss-x]...
(progn ; then get endpoints.
(setq -_pnt1 (cdr (assoc 10 -_enty))
-_pnt2 (cdr (assoc 11 -_enty))
-_ang1 (angle -_pnt1 -_pnt2)
-_dist (/ (distance -_pnt1 -_pnt2) 2.0)
-_mid1 (polar -_pnt1 -_ang1 -_dist)
)
(cond
((equal -_ang1 0.0 -_rang) (setq -_ang2 0.0)) ;angle above 0 degrees
((equal -_ang1 (* pi 0.5) -_rang)(setq -_ang2 (* pi 0.5))) ;angle around 90 degrees
((equal -_ang1 pi -_rang) (setq -_ang2 pi)) ;angle around 180 degrees
((equal -_ang1 (* pi 1.5) -_rang)(setq -_ang2 (* pi 1.5))) ;angle around 270 degrees
((equal -_ang1 (* pi 2.0) -_rang)(setq -_ang2 0.0)) ;angle below 0 (360) degrees.
(T (setq -ang2 nil))
)
(if -_ang2
(progn
(setq -_pnta (polar -_mid1 (+ -_ang2 pi) -_dist)
-_pntb (polar -_mid1 -_ang2 -_dist)
)
(setq -_enty (subst (cons 10 -_pnta) (assoc 10 -_enty)
-_enty)
-_enty (subst (cons 11 -_pntb) (assoc 11 -_enty)
-_enty)
)
(entmod -_enty)
) ; end of progn.
) ; end of if.

) ; end of progn.
) ; end of if.
) ; End of repeat.

(setvar "CMDECHO" svcmde)
(princ)
)

;=================================================================
(princ "\nLine straighten function is now loaded. Enter orthoize to run.")
(princ)
;========================== End of file ==========================
(c:ort)

Advertisements