Help me to update an angle lisp code

[mhy3sx]

I use this code to dimension close polylines with  length text and azimuth angle in grads.

I want to change this azimutha angle to

1)The angle between  red and green line. Red line is always vertical and is the North direction.

2) the green line is always vertical to each polyline side

3) The angle must be in degrees

Look the attach file

 

(defun c:test ()

;---------------Sub-functions - Start-------------
(defun PARALELO ()
;---------------------------------------------------------------
(setq A1 (polar A (+ (/ pi 2)(angle B A )) (+ (* 0.05 2.5)))) 
(setq B1 (polar B (+ (/ pi 2)(angle B A )) (+ (* 0.05 2.5))))
;--------------------------------------------------------------
(setq ptx (/ (+ (car B1) (car A1)) 2))
(setq pty (/ (+ (cadr B1) (cadr A1)) 2))
(setq ponto_meio (list ptx pty))
;(if (< (car A1)(car B1))
;(setq inicio B1)
(setq inicio A1)
;)
)
;----------------Sub-functions - End -------------
(setvar"cmdecho" 0)
(setq flagv "falso")
(setq controle 0)
(setq controle1 0)
(setq contador 0)
(while (= flagv "falso")
(setq mostre (entsel "\nSelect a clock wise polyline <2d> : "))
(setq linha (entget (car mostre )))
(setq verificador (cdr(assoc 0 linha)))
(if (= verificador "LWPOLYLINE")
(progn
(setq verif (cdr (assoc 70 linha)))
(setq flagv "verdade")
)
(princ "\nThis is not a Polyline !! ")
)
)
(setq controle1 (length linha))
(setq amostra '())
(repeat controle1
(setq x (caar linha))
(if (= x 10)
(progn
(setq item (car linha))
(setq amostra (cons item amostra))
(setq contador (1+ contador))
)
)
(setq linha (cdr linha))
)
(setq amostra1 (reverse amostra))
(if (= verif 1)
(setq amostra (cons (car amostra1) amostra))
(setq contador (1- contador))
)
(setq controle contador)
(repeat controle
(setq PTO1 (cdr(car amostra)))
(setq PTO2 (cdr(car(cdr amostra))))
(AZIMUTAR)
(setq amostra(cdr amostra))
)
(command "undo" "end")
(setvar "textsize" 0.5)
(setvar"cmdecho" 1)
(princ)
)
;--------------------------------------------------------- 
(defun AZIMUTAR ()
(setq A PTO1)
(setq B PTO2)
(setq C " - Angle ")
(setq D (angtos (angle B A))) 
(setq PALAV D)
;------------- MODIFICACAO ROGERIO OPCAO AZIMUTE ----------------
(setq E (strcat (rtos (distance A B) 2 3) "m"))
(setq DADO (strcat E C PALAV))
;---------------------------------------------------------- ------
(PARALELO)
(if (zerop (cdr (assoc 40 (entget (tblobjname "style" (getvar 'textstyle))))))
  (command "_.-text" "_justify" "_Bc" "_non" ponto_meio ht "_non" inicio dado)
  (command "_.-text" "_justify" "_Bc" "_non" ponto_meio "_non" inicio dado)
)
(princ)
)
 

 

Thanks

 

 

 

test.dwg

Edited April 8, 2023 by mhy3sx

[BIGAL]

(setq mostre (entsel "\nSelect a clock wise polyline <2d> : "))

 

; Checking if pline is CW or CCW and set to CCW
; Orignal idea  by Kent Cooper, 1 August 2018 Offsetinorout.lsp
; By Alan H July 2020

(defun AH:chkcwccw (ent / objnew area1 area2 obj minpoint maxpoint)

(setq obj (vlax-ename->vla-object ent))
(vla-GetBoundingBox obj 'minpoint 'maxpoint)
(setq pointmin (vlax-safearray->list minpoint))
(setq pointmax (vlax-safearray->list maxpoint))
(setq dist (/ (distance pointmin pointmax) 20.0))

(vla-offset obj dist)
(setq objnew (vlax-ename->vla-object (entlast)))
(setq area1  (vlax-get objnew 'Area))
(vla-delete objnew)

(vla-offset obj (- dist))
(setq objnew (vlax-ename->vla-object (entlast)))
(setq area2  (vlax-get objnew 'Area))
(vla-delete objnew)

(if (> area1 area2)
  (progn
  (command "reverse" ent "")
  (setq y (+ y 1))
  )
)
)

If using Bricscad use Pedit R.

[mhy3sx]

Hi BIGAL, Can any one help me how calculate the angle between green and red line in degrees?

 

Thanks

 

(defun c:test ()

;---------------Sub-functions - Start-------------
(defun PARALELO ()
;---------------------------------------------------------------
(setq A1 (polar A (+ (/ pi 2)(angle B A )) (+ (* 0.05 2.5)))) 
(setq B1 (polar B (+ (/ pi 2)(angle B A )) (+ (* 0.05 2.5))))
;--------------------------------------------------------------
(setq ptx (/ (+ (car B1) (car A1)) 2))
(setq pty (/ (+ (cadr B1) (cadr A1)) 2))
(setq ponto_meio (list ptx pty))
;(if (< (car A1)(car B1))
;(setq inicio B1)
(setq inicio A1)
;)
)
;----------------Sub-functions - End -------------
(setvar"cmdecho" 0)
(setq flagv "falso")
(setq controle 0)
(setq controle1 0)
(setq contador 0)
(while (= flagv "falso")
(setq mostre (entsel "\nSelect a clock wise polyline <2d> : "))
(setq linha (entget (car mostre )))
(setq verificador (cdr(assoc 0 linha)))
(if (= verificador "LWPOLYLINE")
(progn
(setq verif (cdr (assoc 70 linha)))
(setq flagv "verdade")
)
(princ "\nThis is not a Polyline !! ")
)
)
(setq controle1 (length linha))
(setq amostra '())
(repeat controle1
(setq x (caar linha))
(if (= x 10)
(progn
(setq item (car linha))
(setq amostra (cons item amostra))
(setq contador (1+ contador))
)
)
(setq linha (cdr linha))
)
(setq amostra1 (reverse amostra))
(if (= verif 1)
(setq amostra (cons (car amostra1) amostra))
(setq contador (1- contador))
)
(setq controle contador)
(repeat controle
(setq PTO1 (cdr(car amostra)))
(setq PTO2 (cdr(car(cdr amostra))))
(AZIMUTAR)
(setq amostra(cdr amostra))
)
(command "undo" "end")
(setvar"cmdecho" 1)
(princ)
)
;--------------------------------------------------------- 
(defun AZIMUTAR ()
(setq A PTO1)
(setq B PTO2)
(setq C " - Angle ")
(setq D (angtos (angle B A))) 
(setq PALAV D)
;------------- MODIFICACAO ROGERIO OPCAO AZIMUTE ----------------
(setq E (strcat (rtos (distance A B) 2 3) "m"))
(setq DADO (strcat E C PALAV))
;---------------------------------------------------------- ------
(PARALELO)
(if (zerop (cdr (assoc 40 (entget (tblobjname "style" (getvar 'textstyle))))))
  (command "_.-text" "_justify" "_Bc" "_non" ponto_meio 0.5 "_non" inicio dado)
  (command "_.-text" "_justify" "_Bc" "_non" ponto_meio "_non" inicio dado)
)
(princ)
)
 

test.dwg

[mhy3sx]

Is any way to calculate this angles correct in degrees?

 

Thansk

Edited April 9, 2023 by mhy3sx

[mhy3sx]

I convert it to degrees , but I need help to calculate the correct angle

 

 

(defun c:test ()

;---------------Sub-functions - Start-------------
(defun PARALELO ()
(SETVAR "AUNITS" 0)
;---------------------------------------------------------------
(setq A1 (polar A (+ (/ pi 2)(angle B A )) (+ (* 0.05 2.5)))) 
(setq B1 (polar B (+ (/ pi 2)(angle B A )) (+ (* 0.05 2.5))))
;--------------------------------------------------------------
(setq ptx (/ (+ (car B1) (car A1)) 2))
(setq pty (/ (+ (cadr B1) (cadr A1)) 2))
(setq ponto_meio (list ptx pty))
;(if (< (car A1)(car B1))
;(setq inicio B1)
(setq inicio A1)
;)
)
;----------------Sub-functions - End -------------
(setvar"cmdecho" 0)
(setq flagv "falso")
(setq controle 0)
(setq controle1 0)
(setq contador 0)
(while (= flagv "falso")
(setq mostre (entsel "\nSelect a clock wise polyline <2d> : "))
(setq linha (entget (car mostre )))
(setq verificador (cdr(assoc 0 linha)))
(if (= verificador "LWPOLYLINE")
(progn
(setq verif (cdr (assoc 70 linha)))
(setq flagv "verdade")
)
(princ "\nThis is not a Polyline !! ")
)
)
(setq controle1 (length linha))
(setq amostra '())
(repeat controle1
(setq x (caar linha))
(if (= x 10)
(progn
(setq item (car linha))
(setq amostra (cons item amostra))
(setq contador (1+ contador))
)
)
(setq linha (cdr linha))
)
(setq amostra1 (reverse amostra))
(if (= verif 1)
(setq amostra (cons (car amostra1) amostra))
(setq contador (1- contador))
)
(setq controle contador)
(repeat controle
(setq PTO1 (cdr(car amostra)))
(setq PTO2 (cdr(car(cdr amostra))))
(AZIMUTAR)
(setq amostra(cdr amostra))
)
(command "undo" "end")
(setvar"cmdecho" 1)
(princ)
)
;--------------------------------------------------------- 
(defun AZIMUTAR ()
(setq A PTO1)
(setq B PTO2)
(setq C " - Angle ")
(setq D (angtos (angle B A)))
(setq PALAV D)
;------------- MODIFICACAO ROGERIO OPCAO AZIMUTE ----------------
(setq E (strcat (rtos (distance A B) 2 2) "m"))
(setq DADO (strcat E C PALAV))
;---------------------------------------------------------- ------
(PARALELO)
(if (zerop (cdr (assoc 40 (entget (tblobjname "style" (getvar 'textstyle))))))
  (command "_.-text" "_justify" "_Bc" "_non" ponto_meio 0.5 "_non" inicio dado)
  (command "_.-text" "_justify" "_Bc" "_non" ponto_meio "_non" inicio dado)
)
(princ)
)

 

 

 

thanks

[Tsuky]

And if you change simply:

(setq D (angtos (angle B A)))

to

(setq D (angtos (- (angle B A) (* 0.5 pi)) 0 3))

[mhy3sx]

Thanks Tsuky