Angle of polyline with tilt.

[HarrySK]

I'm trying to angle of polyline. Identify Angle of the polyline left side or right side is which side tilt. And it must report in CSV format. Attached lisp file, it gives polyline angles.

Advance Thanks.

(defun w_ang? ( p1 px p2 / l_pt l_d p ang)
(setq
l_pt (mapcar '(lambda (x) (list (car x) (cadr x))) (list px p1 p2))
l_d (mapcar 'distance l_pt (append (cdr l_pt) (list (car l_pt))))
p (/ (apply '+ l_d) 2.0)
)
(if (zerop (* p (- p (cadr l_d))))
(setq ang pi)
(setq ang (* (atan (sqrt (/ (* (- p (car l_d)) (- p (caddr l_d))) (* p (- p (cadr l_d)))))) 2.0))
)
(angtos (- pi ang) (getvar "AUNITS") (getvar "AUPREC"))
)
(defun c:id_pline_ang ( / js a_base a_dir ent dxf_ent pt_lst l_ang)
(while (not (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))))
(setq
a_base (getvar "ANGBASE")
a_dir (getvar "ANGDIR")
ent (ssname js 0)
dxf_ent (entget ent)
pt_lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent))
)
(setvar "ANGBASE" 0)
(setvar "ANGDIR" 0)
(while (and (car pt_lst) (cadr pt_lst) (caddr pt_lst))
(setq
l_ang (cons (w_ang? (car pt_lst) (cadr pt_lst) (caddr pt_lst)) l_ang)
pt_lst (cdr pt_lst)
)
)
(setvar "ANGBASE" a_base)
(setvar "ANGDIR" a_dir)
(reverse l_ang)
)

[HarrySK]

Revised bearig excel sheet.

[CADaSchtroumpf]

With bearing...

(defun c:deflection_ang ( / js a_base a_dir ent dxf_ent pt_lst bear count l_ang cumd ang0 ang1 ang v1 v2 det_or file2open f_open)
  (while (not (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))))
  (setq
    a_base (getvar "ANGBASE")
    a_dir (getvar "ANGDIR")
    ent (ssname js 0)
    dxf_ent (entget ent)
    pt_lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent))
  )
  (setvar "ANGDIR" 1)
  (setvar "ANGBASE" (* 0.5 pi))
  (setq bear (angtos (angle (car pt_lst) (cadr pt_lst)) 1 4))
  (setvar "ANGDIR" 0)
  (setvar "ANGBASE" 0)
  (setq
    count 0
    l_ang
      (list
        (strcat "P" (itoa count) ","
          (vl-string-subst "°" "d" (angtos 0.0 1 4)) ", ,"
          (vl-string-subst "°" "d" bear) ",0.000\n" 
        )
      )
    cumd 0.0
  )
  (while
    (and
      (car pt_lst)
      (cadr pt_lst)
      (caddr pt_lst)
    )
    (setq
      ang0 (angle (car pt_lst) (cadr pt_lst))
      ang1 (angle (cadr pt_lst) (caddr pt_lst))
      ang (abs (- ang0 ang1))
      ang (if (or (> ang (* 0.5 pi)) (< ang 0.0)) (abs (- (* 2 pi) ang)) ang)
      ang (if (> ang pi) (rem (* 2 pi) ang) ang)
    )
    (setvar "ANGDIR" 1)
    (setvar "ANGBASE" (* 0.5 pi))
    (setq bear (angtos (angle (cadr pt_lst) (caddr pt_lst)) 1 4))
    (setvar "ANGDIR" 0)
    (setvar "ANGBASE" 0)
    (setq
      v1 (mapcar '- (polar (cadr pt_lst) ang0 1.0) (cadr pt_lst))
      v2 (mapcar '- (caddr pt_lst) (cadr pt_lst))
      det_or (apply '(lambda (x1 y1 x2 y2) (- (* x1 y2) (* y1 x2))) (append v1 v2))
      count (1+ count)
      l_ang
        (cons
          (strcat
            "P" (itoa count) ","
            (vl-string-subst "°" "d" (angtos ang 1 4))
            (if (< det_or 0.0) ",Rt." ",Lt.") ","
            (vl-string-subst "°" "d" bear) ","
            (rtos (setq cumd (+ cumd (distance (car pt_lst) (cadr pt_lst)))) 2 3) "\n"
          )
          l_ang
        )
      pt_lst (cdr pt_lst)
    )
  )
  (setq l_ang
    (cons
      (strcat
        "P" (itoa (1+ count)) ","
        (vl-string-subst "°" "d" (angtos 0.0 1 4)) ", ,"
        (vl-string-subst "°" "d" (angtos 0.0 1 4)) ","
        (rtos (+ cumd (distance (car pt_lst) (cadr pt_lst))) 2 3) "\n"
      )
      l_ang
    )
  )
  (setvar "ANGBASE" a_base)
  (setvar "ANGDIR" a_dir)
  (setq
    file2open (strcat (getvar "DWGPREFIX") (getvar "DWGNAME") ".CSV")
    f_open (open file2open "w")
  )
  (princ "Points,Angle (DMS),L/R,Bearing,Chainage\n" f_open)
  (foreach n (reverse l_ang)
    (princ n f_open)
  )
  (close f_open)
  (princ (strcat "\nInfo as be writen in " (getvar "DWGPREFIX") (getvar "DWGNAME") ".CSV"))
  (prin1)
)

[HarrySK]

Sir, I think the 0°0'0" should not come in the end of the bearing. In the beginning of 0°0'0" to be so good. I am sorry for the trouble.

[CADaSchtroumpf]

In your exemple in post 21, you wrote for P169 a bearing to : 132°28'01"

I don't understand how you obtain this?!

I have prefer to writre 0d0'0" at this place

If you want nothing, change:

    (setq l_ang
        (cons
            (strcat
                "P" (itoa (1+ count)) ","
                (vl-string-subst "°" "d" (angtos 0.0 1 4)) ", ,"
                (vl-string-subst "°" "d" (angtos 0.0 1 4)) ","
                (rtos (+ cumd (distance (car pt_lst) (cadr pt_lst))) 2 3) "\n"
            )
            l_ang
        )
    )

by:

    (setq l_ang
        (cons
            (strcat
                "P" (itoa (1+ count)) ","
                "" ", ,"
                "" ","
                (rtos (+ cumd (distance (car pt_lst) (cadr pt_lst))) 2 3) "\n"
            )
            l_ang
        )
    )

[HarrySK]

I have to highlight in red the changes were meant to. I had the correct change in csv.

If the right changes is shown in red (Images).

[CADaSchtroumpf · Accepted solution]

With arrangements?

[HarrySK]

Thank you very much.

[HarrySK]

Sir, I again found an error in your Lisp. Please Point No. 77, 101, 114 check.

[ВeekeeCZ]

As I watch this thread so I wonder, would not it be much easier to export only the angle of each segment in radians and you would count all you need in Excel?

[CADaSchtroumpf]

I don't have problem with the file generated!

I don't know why you have this problem!

NB: 12°43'0" = 12°42'60" but the notation is not correct

See my CSV

[HarrySK]

AutoCAD drawing file was a problem. Polyline pasted into another drawing so CSV come correct answer. I am sorry about the trouble.

[symoin]

Dear Sir,

Thanks for the routine, Can I request you update the code to give the coordinates easting and northing also along with these details.

Many thanks in Advance.

[CADaSchtroumpf]

---

@symoin  a écrit :

Dear Sir,

Thanks for the routine, Can I request you update the code to give the coordinates easting and northing also along with these details.

Many thanks in Advance.

---

@symoin 

It's easy to update the code with  coordinates Easting and Northing.