Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Angle of polyline with tilt.

32 REPLIES 32
SOLVED
Reply
Message 1 of 33
HarrySK
2041 Views, 32 Replies

Angle of polyline with tilt.

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)
)
32 REPLIES 32
Message 2 of 33
ВeekeeCZ
in reply to: HarrySK

Hi, try it simple....

 

  (while (and (car pt_lst)
	      (cadr pt_lst)
	      (caddr pt_lst))
    (setq
      l_ang (cons (- (angle (car pt_lst) (cadr pt_lst))  ;(w_ang? (car pt_lst) (cadr pt_lst) (caddr pt_lst)) l_ang)
		     (angle (cadr pt_lst) (caddr pt_lst))) 
		  l_ang)
      pt_lst (cdr pt_lst)
      )
    )

The result is positive or negative angle on radians. Then you can use (angtos rad 0 0) to convert that into degrees, where 180 is the edge between positive or negative.

 

How to export to cvs file you can see here

Message 3 of 33
HarrySK
in reply to: ВeekeeCZ

BeekeeCZ,

           Thank you very much for your support. But it is Possible in that format 00°00'00"Rt./Lt.

Message 4 of 33
ВeekeeCZ
in reply to: HarrySK

Maybe something like this.

 

Spoiler
(defun c:id_pline_ang ( / *error* file js ent dxf_ent pt_lst l_ang ang)

  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if file (close file))
    (princ))

  
  (while (not (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))))
  (setq
    ent (ssname js 0)
    dxf_ent (entget ent)
    pt_lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent))
    )
  (while (and (car pt_lst)
	      (cadr pt_lst)
	      (caddr pt_lst))
    (setq
      l_ang (cons (if (minusp (setq ang (- (angle (car  pt_lst) (cadr  pt_lst)) 
					   (angle (cadr pt_lst) (caddr pt_lst)))))
		    (strcat (vl-string-subst "°" "d" (angtos (- (* 2 pi) ang) 1 4)) "Lt.")
		    (strcat (vl-string-subst "°" "d" (angtos ang 1 4)) "Rt."))
		  l_ang)
      pt_lst (cdr pt_lst)
      )
    )
  (print (reverse l_ang))

  (if (setq file (open (strcat (getvar 'DWGPREFIX) (vl-string-right-trim ".dwg" (getvar 'DWGNAME)) ".csv") "a"))
    (progn
      (write-line "----------------" file)
      (foreach e l_ang (write-line e file))))
  
  (*error* "end")
)
Message 5 of 33
HarrySK
in reply to: ВeekeeCZ

Sir, your Lisp code used on other alignment but the results are wrong. You have to download the file. Please give the Lisp code improvements.Please change file extension .txt to .xls

Message 6 of 33
CADaSchtroumpf
in reply to: HarrySK

Hello,

 

With the first one modified...

(defun c:id_pline_ang ( / js a_base a_dir ent dxf_ent pt_lst count l_ang **** 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" 0)
  (setvar "ANGBASE" 0.0)
  (setq  count 0 l_ang (list (strcat "P" (itoa count) "," "\""(angtos 0.0 1 4)"\"" "\"" "\"" ",0" )) **** 0.0)
  (while
    (and
      (car pt_lst)
      (cadr pt_lst)
      (caddr pt_lst)
    )
    (setq
      ang (- (angle (car pt_lst) (cadr pt_lst)) (angle (cadr pt_lst) (caddr pt_lst)))
      count (1+ count)
      l_ang (cons (strcat "P" (itoa count) "," "\"" (angtos (if (< ang 0.0) (- (* 2 pi) ang) ang) 1 4) "\"" (if (< ang 0.0) "Lt." "Rt.") "," (rtos (setq **** (+ **** (distance (car pt_lst) (cadr pt_lst)))) 2 4)) l_ang)
      pt_lst (cdr pt_lst)
      
    )
  )
  (setq l_ang (cons (strcat "P" (itoa (1+ count)) "," "\""(angtos 0.0 1 4)"\"" "\"" "\"" "," (rtos (+ **** (distance (car pt_lst) (cadr pt_lst))) 2 4)) l_ang))
  (setvar "ANGBASE" a_base)
  (setvar "ANGDIR" a_dir)
  (setq file2open (strcat (getvar "DWGPREFIX") (getvar "DWGNAME") ".CSV"))
  (setq f_open (open file2open "w"))
  (write-line "Points,Angle (DMS),Chainage" f_open)
  (foreach n (reverse l_ang)
    (write-line n f_open)
  )
  (close f_open)
  (princ (strcat "\nInfo as be writen in " (getvar "DWGPREFIX") (getvar "DWGNAME") ".CSV"))
  (prin1)
)
Message 7 of 33
HarrySK
in reply to: CADaSchtroumpf

CADaStroumph, Thank you, but you also have your Lisp angle missing and Please download post no. 5 table3.xls file and compare angle in Column "B" what the answer is correct.

Message 8 of 33
CADaSchtroumpf
in reply to: HarrySK

OK, I have understand.

 

Change with this:

 

(defun c:id_pline_ang ( / js a_base a_dir ent dxf_ent pt_lst count l_ang cumd 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" 0)
  (setvar "ANGBASE" 0.0)
  (setq  count 0 l_ang (list (strcat "P" (itoa count) "," "\""(angtos 0.0 1 4)"\"" "\"" "\"" ",0" )) cumd 0.0)
  (while
    (and
      (car pt_lst)
      (cadr pt_lst)
      (caddr pt_lst)
    )
    (setq
      ang (abs (- (angle (car pt_lst) (cadr pt_lst)) (angle (cadr pt_lst) (caddr pt_lst))))
      count (1+ count)
      l_ang (cons (strcat "P" (itoa count) "," "\"" (angtos (if (or (> ang (* 0.5 pi)) (< ang 0.0)) (abs (- (* 2 pi) ang)) ang) 1 4) "\"" (if (or (> ang (* 0.5 pi)) (< ang 0.0)) "Lt." "Rt.") "," (rtos (setq cumd (+ cumd (distance (car pt_lst) (cadr pt_lst)))) 2 4)) l_ang)
      pt_lst (cdr pt_lst)
      
    )
  )
  (setq l_ang (cons (strcat "P" (itoa (1+ count)) "," "\""(angtos 0.0 1 4)"\"" "\"" "\"" "," (rtos (+ cumd (distance (car pt_lst) (cadr pt_lst))) 2 4)) l_ang))
  (setvar "ANGBASE" a_base)
  (setvar "ANGDIR" a_dir)
  (setq file2open (strcat (getvar "DWGPREFIX") (getvar "DWGNAME") ".CSV"))
  (setq f_open (open file2open "w"))
  (write-line "Points,Angle (DMS),Chainage" f_open)
  (foreach n (reverse l_ang)
    (write-line n f_open)
  )
  (close f_open)
  (princ (strcat "\nInfo as be writen in " (getvar "DWGPREFIX") (getvar "DWGNAME") ".CSV"))
  (prin1)
)

I have converted angle in (abs ang) and tested ang < 0.0 or ang >pi/2

Message 9 of 33
HarrySK
in reply to: CADaSchtroumpf

CADaStroumph Sir, this time angle is correct but Still two problems. The first problem is left or right direction is wrong. And Secod problem is, every second point in CSV is skipping. I should continue point each. Thank you.

Message 10 of 33
CADaSchtroumpf
in reply to: HarrySK

I hope that is good!

Spoiler
 
(defun c:deflection_ang ( / js a_base a_dir ent dxf_ent pt_lst ang0 ang1 ang v1 v2 det_or count l_ang cumd 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" 0)
  (setvar "ANGBASE" 0.0)
  (setq  count 0 l_ang (list (strcat "P" (itoa count) "," "\""(angtos 0.0 1 4)"\"" "\"" "\"" ",0.0\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))
      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) "," "\"" (angtos (if (or (> ang (* 0.5 pi)) (< ang 0.0)) (abs (- (* 2 pi) ang)) ang) 1 4) "\"" (if (< det_or 0.0) "Rt." "Lt.") "," (rtos (setq cumd (+ cumd (distance (car pt_lst) (cadr pt_lst)))) 2 4) "\n") l_ang)
      pt_lst (cdr pt_lst)
      
    )
  )
  (setq l_ang (cons (strcat "P" (itoa (1+ count)) "," "\""(angtos 0.0 1 4)"\"" "\"" "\"" "," (rtos (+ cumd (distance (car pt_lst) (cadr pt_lst))) 2 4) "\n") l_ang))
  (setvar "ANGBASE" a_base)
  (setvar "ANGDIR" a_dir)
  (setq file2open (strcat (getvar "DWGPREFIX") (getvar "DWGNAME") ".CSV"))
  (setq f_open (open file2open "w"))
  (princ "Points,Angle (DMS),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)
)
Message 11 of 33
HarrySK
in reply to: CADaSchtroumpf

Thank you sir, but this is still some incorrect in angle. Please check point no. 42 and 159.

Message 12 of 33
ВeekeeCZ
in reply to: HarrySK

Erased by user.
Message 13 of 33
CADaSchtroumpf
in reply to: HarrySK

With the fixing things...

Try to change

    (setq
      ang0 (angle (car pt_lst) (cadr pt_lst))
      ang1 (angle (cadr pt_lst) (caddr pt_lst))
      ang (abs (- ang0 ang1))
      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) "," "\"" (angtos (if (or (> ang (* 0.5 pi)) (< ang 0.0)) (abs (- (* 2 pi) ang)) ang) 1 4) "\"" (if (< det_or 0.0) "Rt." "Lt.") "," (rtos (setq cumd (+ cumd (distance (car pt_lst) (cadr pt_lst)))) 2 4) "\n") l_ang)
      pt_lst (cdr pt_lst)
      
    )

with

    (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)
      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) "," "\"" (angtos ang 1 4) "\"" (if (< det_or 0.0) "Rt." "Lt.") "," (rtos (setq cumd (+ cumd (distance (car pt_lst) (cadr pt_lst)))) 2 4) "\n") l_ang)
      pt_lst (cdr pt_lst)
      
    )
Message 14 of 33
HarrySK
in reply to: CADaSchtroumpf

CADaStroumph, Thank you very much it is working very well.

Message 15 of 33
HarrySK
in reply to: CADaSchtroumpf

"D" instead of the "°" degree symbol to the it can get.
Message 16 of 33
CADaSchtroumpf
in reply to: HarrySK


HarrySK a écrit :
"D" instead of the "°" degree symbol to the it can get.

For me is right !!!, what return : (angtos pi 1 4) for you?

(angtos pi 1 4) -> "180d0'0\"" for Autocad Map 2014 French

Message 17 of 33
HarrySK
in reply to: CADaSchtroumpf

Sir, if possible if only "00d00'00"" instead of 00°00'00"" on with this format can be.
Message 18 of 33
HarrySK
in reply to: CADaSchtroumpf

beekeeCZ,

           Thanks was made possible by their code. (vl-string-subst "°" "d").

           Thank you also to the help of CADaStroumph.

Message 19 of 33
CADaSchtroumpf
in reply to: HarrySK

I don't understand your question! I'm French.

 

Perhaps you can make for (angtos pi 1 4) -> 180d0'0" :

If you wont the symbole degree at place of "d", use (vl-string-subst "°" "d" (angtos pi 1 4)) -> 180°0'0"

in the code replace (angtos ang 1 4) by (vl-string-subst "°" "d" (angtos ang 1 4))

 

Find in the code other angtos if you wont replace the other "0d0'0"" by 0°0'0""

Message 20 of 33
HarrySK
in reply to: CADaSchtroumpf

Please you can add bearing.

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

AutoCAD Inside the Factory


Autodesk Design & Make Report