Topic: Pline: Is ortho? (segments)

[Marc'Antonio Alessi]

Is this enough or are there suggestions?

Code: [Select]

(defun C:test1 ()
  (and
    (ALE_Pline_OrtoP (car (entsel "Select Pline: "))  0.00001)
    (princ "\nPline IS Ortho. ")
  )
  (princ)
)
(defun ALE_Pline_OrtoP (EntNam FuzFac / VtrLst OutFlg)
  (repeat (1- (length (setq VtrLst (cdrs 10 (entget EntNam)))))
    (setq
      OutFlg (ALE_Utl_OrthoP (angle (car VtrLst) (cadr VtrLst)) FuzFac)
      VtrLst (cdr VtrLst)
    )
  )
  OutFlg
)
(defun ALE_Utl_OrthoP (OrtAng FuzFac)
  (or
    (equal OrtAng         0  FuzFac)
    (equal OrtAng (* 0.5 pi) FuzFac)
    (equal OrtAng        pi  FuzFac)
    (equal OrtAng (* 1.5 pi) FuzFac)
    (equal OrtAng (* 2   pi) FuzFac)
   )
)
;
; M. Puckett
(defun cdrs ( key lst / pair result )
   (while (setq pair (assoc key lst))
      (setq result (cons (cdr pair) result)
         lst (cdr (member pair lst))
      )
   )
   (reverse result)
)


[Lee Mac]

Here's my initial draft:

Code - Auto/Visual Lisp: [Select]

1. (defun ortho-p ( ent fuz )
2.     (   (lambda ( fun ) (fun (entget ent) fuz))
3.         (lambda ( enx fuz / ang vt1 vt2 )
4.             (or (not (and (setq vt1 (assoc 10 enx))
5.                           (setq enx (cdr (member vt1 enx)))
6.                           (setq vt2 (assoc 10 enx))
7.                      )
8.                 )
9.                 (and (equal 0.0 (cdr (assoc 42 enx)) fuz)
10.                      (setq ang (rem (angle (cdr vt1) (cdr vt2)) (/ pi 2.0)))
11.                      (or (equal 0.0 ang fuz) (equal (/ pi 2.0) ang fuz))
12.                      (fun enx fuz)
13.                 )
14.             )
15.         )
16.     )
17. )

To account for closed polylines (thanks roy):

Code - Auto/Visual Lisp: [Select]

1. (defun ortho-p ( ent fuz )
2.     (   (lambda ( fun enx )
3.             (if (= 1 (logand 1 (cdr (assoc 70 enx))))
4.                 (fun (cons (assoc 10 (reverse enx)) enx) fuz)
5.                 (fun enx fuz)
6.             )
7.         )
8.         (lambda ( enx fuz / ang vt1 vt2 )
9.             (or (not (and (setq vt1 (assoc 10 enx))
10.                           (setq enx (cdr (member vt1 enx)))
11.                           (setq vt2 (assoc 10 enx))
12.                      )
13.                 )
14.                 (and (equal 0.0 (cdr (assoc 42 enx)) fuz)
15.                      (setq ang (rem (angle (cdr vt1) (cdr vt2)) (/ pi 2.0)))
16.                      (or (equal 0.0 ang fuz) (equal (/ pi 2.0) ang fuz))
17.                      (fun enx fuz)
18.                 )
19.             )
20.         )
21.         (entget ent)
22.     )
23. )

Code - Auto/Visual Lisp: [Select]

1. (defun c:test ( / sel )
2.     (if (setq sel (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))
3.         (ortho-p (ssname sel 0) 1e-8)
4.     )
5. )

[Lee Mac]

Another option, with reliance on integer parameters at vertices:

Code - Auto/Visual Lisp: [Select]

1. (defun ortho-p ( ent fuz / ang end par )
2.     (setq end (vlax-curve-getendparam ent)
3.           par 0
4.     )
5.     (while
6.         (and
7.             (< par end)
8.             (setq ang (rem (angle '(0.0 0.0) (vlax-curve-getfirstderiv ent par)) (/ pi 2.0)))
9.             (or (equal 0.0 ang fuz) (equal (/ pi 2.0) ang fuz))
10.             (equal '(0.0 0.0 0.0) (vlax-curve-getsecondderiv ent par) fuz)
11.         )
12.         (setq par (1+ par))
13.     )
14.     (= par end)
15. )

Or, recursively:

Code - Auto/Visual Lisp: [Select]

1. (defun ortho-p ( ent fuz )
2.     (   (lambda ( fun ) (fun ent fuz 0 (vlax-curve-getendparam ent)))
3.         (lambda ( ent fuz par end / ang )
4.             (or (= par end)
5.                 (and (setq ang (rem (angle '(0.0 0.0) (vlax-curve-getfirstderiv ent par)) (/ pi 2.0)))
6.                      (or (equal 0.0 ang fuz) (equal (/ pi 2.0) ang fuz))
7.                      (equal '(0.0 0.0 0.0) (vlax-curve-getsecondderiv ent par) fuz)
8.                      (fun ent fuz (1+ par) end)
9.                 )
10.             )
11.         )
12.     )
13. )

Alternatively, comparing the coordinate values of the first-derivative vector (thanks for the idea VovKa):

Code - Auto/Visual Lisp: [Select]

1. (defun ortho-p ( ent fuz / der end par )
2.     (setq end (vlax-curve-getendparam ent)
3.           par 0
4.     )
5.     (while
6.         (and
7.             (< par end)
8.             (setq der (vlax-curve-getfirstderiv ent par))
9.             (or (equal 0.0 (car der) fuz) (equal 0.0 (cadr der) fuz))
10.             (equal '(0.0 0.0 0.0) (vlax-curve-getsecondderiv ent par) fuz)
11.         )
12.         (setq par (1+ par))
13.     )
14.     (= par end)
15. )

Code - Auto/Visual Lisp: [Select]

1. (defun ortho-p ( ent fuz )
2.     (   (lambda ( fun ) (fun ent fuz 0 (vlax-curve-getendparam ent)))
3.         (lambda ( ent fuz par end / der )
4.             (or (= par end)
5.                 (and (setq der (vlax-curve-getfirstderiv ent par))
6.                      (or (equal 0.0 (car der) fuz) (equal 0.0 (cadr der) fuz))
7.                      (equal '(0.0 0.0 0.0) (vlax-curve-getsecondderiv ent par) fuz)
8.                      (fun ent fuz (1+ par) end)
9.                 )
10.             )
11.         )
12.     )
13. )

[roy_043]

I don't have a code suggestion, but make sure to also check your code with closed polylines.

[VovKa]

or

Code: [Select]

(vl-every (function (lambda (e1 e2)
      (or (equal (car e1) (car e2) FuzFac)
  (equal (cadr e1) (cadr e2) FuzFac)
      )
    )
  )
  VtrLst
  (cdr VtrLst)
)keep in mind that in this case FuzFac must be linear not angular

[Marc'Antonio Alessi]

Code: [Select]

(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

[Lee Mac]

I don't have a code suggestion, but make sure to also check your code with closed polylines.

Thanks roy - I've updated my first post to include code to account for closed polylines.

[Lee Mac]

Added two more functions to this post, inspired by VovKa's method.

[Lee Mac]

@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

As noted above, I have now updated my first function to account for closed polylines, but I also think the supplied tolerance needs to be adjusted for those functions comparing distances as opposed to angles, e.g.:

Code: [Select]

(defun ortho-p1 ( ent fuz )
    (   (lambda ( fun enx )
            (if (= 1 (logand 1 (cdr (assoc 70 enx))))
                (fun (cons (assoc 10 (reverse enx)) enx) fuz)
                (fun enx 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)
                )
            )
        )
        (entget ent)
    )
)
(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 ortho-p4 ( ent fuz / der end par )
    (setq end (vlax-curve-getendparam ent)
          par 0
    )
    (while
        (and
            (< par end)
            (setq der (vlax-curve-getfirstderiv ent par))
            (or (equal 0.0 (car der) fuz) (equal 0.0 (cadr der) fuz))
            (equal '(0.0 0.0 0.0) (vlax-curve-getsecondderiv ent par) fuz)
        )
        (setq par (1+ par))
    )
    (= par end)
)
(defun ortho-p5 ( ent fuz )
    (   (lambda ( fun ) (fun ent fuz 0 (vlax-curve-getendparam ent)))
        (lambda ( ent fuz par end / der )
            (or (= par end)
                (and (setq der (vlax-curve-getfirstderiv ent par))
                     (or (equal 0.0 (car der) fuz) (equal 0.0 (cadr der) 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 ALE_Pline_OrtoP (EntNam FuzFac / VtrLst OutFlg)
  (repeat (1- (length (setq VtrLst (cdrs 10 (entget EntNam)))))
    (setq
      OutFlg (ALE_Utl_OrthoP (angle (car VtrLst) (cadr VtrLst)) FuzFac)
      VtrLst (cdr VtrLst)
    )
  )
  OutFlg
)
(defun ALE_Utl_OrthoP (OrtAng FuzFac)
  (or
    (equal OrtAng         0  FuzFac)
    (equal OrtAng (* 0.5 pi) FuzFac)
    (equal OrtAng        pi  FuzFac)
    (equal OrtAng (* 1.5 pi) FuzFac)
    (equal OrtAng (* 2   pi) FuzFac)
   )
)
;
; M. Puckett
(defun cdrs ( key lst / pair result )
   (while (setq pair (assoc key lst))
      (setq result (cons (cdr pair) result)
         lst (cdr (member pair lst))
      )
   )
   (reverse result)
)
(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 "\northo-p4       \t") (princ (ortho-p4 EntNam 1e-4))
          (princ "\northo-p5       \t") (princ (ortho-p5 EntNam 1e-4))
          (princ "\nALE_Pline_OrtoP\t") (princ (ALE_Pline_OrtoP EntNam 1e-8))
          (princ "\nVvK_Pline_OrtoP\t") (princ (VvK_Pline_OrtoP EntNam 1e-4))
        )
    )
    (princ)
)

[Marc'Antonio Alessi]

Thanks Lee, now seems ok:     

Code: [Select]

Sample A:
ortho-p1         T
ortho-p2         T
ortho-p3         T
ortho-p4         T
ortho-p5         T
ALE_Pline_OrtoP  T
VvK_Pline_OrtoP  T

Sample B:
ortho-p1         T
ortho-p2         T
ortho-p3         T
ortho-p4         T
ortho-p5         T
ALE_Pline_OrtoP  T
VvK_Pline_OrtoP  T

Sample C:
ortho-p1         T
ortho-p2         T
ortho-p3         T
ortho-p4         T
ortho-p5         T
ALE_Pline_OrtoP  T
VvK_Pline_OrtoP  T

Sample D:
ortho-p1         nil
ortho-p2         nil
ortho-p3         nil
ortho-p4         nil
ortho-p5         nil
ALE_Pline_OrtoP  T
VvK_Pline_OrtoP  T

[VovKa]

for closed polylines

Code: [Select]

(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)
)
      )
    )
    (cons (last VtrLst) VtrLst)
    VtrLst
  )
)

[Lee Mac]

Thanks Marc 

Should bulge be considered? - some functions are accounting for this, others aren't.

[Marc'Antonio Alessi]

Thanks Marc 

Should bulge be considered? - some functions are accounting for this, others aren't.

Excuse my ignorance, and without me try to understand something above, can  you indicate what functions are accounting for bulge?
... I was doing a speed test to choose the best for my purpose...  (no bulge)

[Lee Mac]

Excuse my ignorance, and without me try to understand something above, can  you indicate what functions are accounting for bulge?

My posted functions are accounting for bulge (i.e. returning nil if the polyline contains arc segments), yours & VovKa's are not.

[Marc'Antonio Alessi]

Excuse my ignorance, and without me try to understand something above, can  you indicate what functions are accounting for bulge?

My posted functions are accounting for bulge (i.e. returning nil if the polyline contains arc segments), yours & VovKa's are not.

About adiacent vertex (see image and dwg posted) what do you think? we consider orthogonal?