(defun ortho-p1 ( ent fuz )
( (lambda ( fun ) (fun (entget ent) fuz))
(lambda ( enx fuz / ang vt1 vt2 )
(or (not (and (setq vt1 (assoc 10 enx))
(setq enx (cdr (member vt1 enx)))
(setq vt2 (assoc 10 enx))
)
)
(and (equal 0.0 (cdr (assoc 42 enx)) fuz)
(setq ang (rem (angle (cdr vt1) (cdr vt2)) (/ pi 2.0)))
(or (equal 0.0 ang fuz) (equal (/ pi 2.0) ang fuz))
(fun enx fuz)
)
)
)
)
)
(defun ortho-p2 ( ent fuz / ang end par )
(setq end (vlax-curve-getendparam ent)
par 0
)
(while
(and
(< par end)
(setq ang (rem (angle '(0.0 0.0) (vlax-curve-getfirstderiv ent par)) (/ pi 2.0)))
(or (equal 0.0 ang fuz) (equal (/ pi 2.0) ang fuz))
(equal '(0.0 0.0 0.0) (vlax-curve-getsecondderiv ent par) fuz)
)
(setq par (1+ par))
)
(= par end)
)
(defun ortho-p3 ( ent fuz )
( (lambda ( fun ) (fun ent fuz 0 (vlax-curve-getendparam ent)))
(lambda ( ent fuz par end / ang )
(or (= par end)
(and (setq ang (rem (angle '(0.0 0.0) (vlax-curve-getfirstderiv ent par)) (/ pi 2.0)))
(or (equal 0.0 ang fuz) (equal (/ pi 2.0) ang fuz))
(equal '(0.0 0.0 0.0) (vlax-curve-getsecondderiv ent par) fuz)
(fun ent fuz (1+ par) end)
)
)
)
)
)
(defun VvK_Pline_OrtoP (EntNam FuzFac / VtrLst)
(setq VtrLst (cdrs 10 (entget EntNam)))
(vl-every (function (lambda (e1 e2)
(or (equal (car e1) (car e2) FuzFac)
(equal (cadr e1) (cadr e2) FuzFac)
)
)
)
VtrLst
(cdr VtrLst)
)
)
(defun c:test ( / sel EntNam)
(if (setq sel (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))
(progn
(setq EntNam (ssname sel 0))
(princ "\northo-p1 \t") (princ (ortho-p1 EntNam 1e-8))
(princ "\northo-p2 \t") (princ (ortho-p2 EntNam 1e-8))
(princ "\northo-p3 \t") (princ (ortho-p3 EntNam 1e-8))
(princ "\nALE_Pline_OrtoP\t") (princ (ALE_Pline_OrtoP EntNam 1e-8))
(princ "\nVvK_Pline_OrtoP\t") (princ (VvK_Pline_OrtoP EntNam 1e-8))
)
)
(princ)
)
@roy: ok seem all ok
@Vovka: I have bad results in many condition, try also in IsOrtho.dwg
@Lee: I have renamed your functions to test,
in "D" case (side not perfect ex.: 499.99999999) i have this result, what do you think about?
ortho-p1 T
ortho-p2 nil
ortho-p3 nil
and
ALE_Pline_OrtoP T
VvK_Pline_OrtoP T