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) )
Solved! Go to Solution.
Solved by CADaSchtroumpf. Go to Solution.
Solved by CADaSchtroumpf. Go to Solution.
Solved by CADaSchtroumpf. Go to Solution.
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
Maybe something like this.
(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") )
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
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) )
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.
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
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.
I hope that is good!
(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) )
Thank you sir, but this is still some incorrect in angle. Please check point no. 42 and 159.
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) )
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
beekeeCZ,
Thanks was made possible by their code. (vl-string-subst "°" "d").
Thank you also to the help of CADaStroumph.
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""
Can't find what you're looking for? Ask the community or share your knowledge.