« previous next »
Pages: 1 [2]  All |   Go Down

Author Topic: help with azimuth lisp  (Read 3994 times)

0 Members and 1 Guest are viewing this topic.

pedroantonio

  • Guest
Re: help with azimuth lisp
« Reply #15 on: November 19, 2016, 11:38:56 AM »
Hi didier. Yes every angle must be in grads  like the angle of the image.
My unit settings are decimal , grads ,clock wise ,and direction noth and i use annotation texts.
Logged

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: help with azimuth lisp
« Reply #16 on: November 19, 2016, 04:09:54 PM »
This topic (also started by the OP) deals with similar issues and should be of interest:
http://www.theswamp.org/index.php?topic=50075.0
Logged

pedroantonio

  • Guest
Re: help with azimuth lisp
« Reply #17 on: November 19, 2016, 06:43:02 PM »
Hi roy_043 i have try this

Quote
This topic (also started by the OP) deals with similar issues and should be of interest:
http://www.theswamp.org/index.php?topic=50075.0
.

But is not working
Logged

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: help with azimuth lisp
« Reply #18 on: November 20, 2016, 06:14:35 AM »
I think that in the code below your issues have been fixed. Mind that it is still *crap*:
Code - Auto/Visual Lisp: [Select]
  1. ;;; ROTINA PARA COTAR E OU AZIMUTAR POLYLINES - TEXTO NO DESENHO = 2.34 ou 2.34 - Az 23°15´7"
  2. ;;; AS MEDIDAS APARECEM COMO FORAM DIGITADAS NO DESENHO (METROS, MILÍMETROS, ETC)
  3. ;;; A ALTURA DO TEXTO É SOLICITADA NA EXECUÇÃO DA ROTINA E O STYLE É O CORRENTE
  4. ;;; ACERTAR ALTURA DO TEXTO DE ACORDO COM A ESCALA DE PLOTAGEM. PARA DEIXAR EM DEFAULT USE O COMMAND: TEXTSIZE
  5. ;;; Forum www.autolisp.com.br - Nome da rotina original: AZPOL - Autor: Orlei 29/08/2006
  6. ;;; Adaptação: Rogério Zanini e Márcio
  7. ;;;---------------------------------------------------------- ------------------------
  8.  
  9. (princ "\nDigite AP para iniciar - Verificar TextStyle corrente")
  10. (defun C:Ap ()
  11. ;---------------Sub-functions - Start-------------
  12. (defun PARALELO ()
  13. (setq A1 (polar A (+ (/ pi 2) (angle B A)) (+ (* 0.60 htext) (/ htext 2)))) ;0.60 x ALTURA TEXTO = distância do texto da Pline ;MODIFICAÇÃO ROGÉRIO
  14. (setq B1 (polar B (+ (/ pi 2) (angle B A)) (+ (* 0.60 htext) (/ htext 2)))) ;0.60 x ALTURA TEXTO = distância do texto da Pline ;MODIFICAÇÃO ROGÉRIO
  15.  
  16. (setq ptx (/ (+ (car B1) (car A1)) 2))
  17. (setq pty (/ (+ (cadr B1) (cadr A1)) 2))
  18. (setq ponto_meio (list ptx pty))
  19. (if (< (car A1)(car B1))
  20. (setq inicio B1)
  21. (setq inicio A1)
  22. )
  23. )
  24. ;----------------Sub-functions - End -------------
  25. (setvar"cmdecho" 0)
  26. (command "undo" "begin"); Voltar de uma só vez toda a operação da Rotina - ACRESCENTADO ROGÉRIO
  27. (initget "Y N")
  28. (setq opt (getkword "\nIncluir Dados de Azimute? [Y/N] <N>: "))
  29.  
  30. (if (zerop (cdr (assoc 40 (entget (tblobjname "style" (getvar 'textstyle))))))
  31.   (if (not (setq htext (getreal (strcat "\nAltura do texto <" (rtos (getvar "textsize") 2 2) ">: "))))
  32.     (setq htext (getvar "textsize"))
  33.   )
  34. )
  35.  
  36. (setq flagv "falso")
  37. (setq controle 0)
  38. (setq controle1 0)
  39. (setq contador 0)
  40. (while (= flagv "falso")
  41. (setq mostre (entsel "\nSelecione a Polyline <2d> : "))
  42. (setq linha (entget (car mostre )))
  43. (setq verificador (cdr(assoc 0 linha)))
  44. (if (= verificador "LWPOLYLINE")
  46. (setq verif (cdr (assoc 70 linha)))
  47. (setq flagv "verdade")
  48. )
  49. (princ "\nNão é Polyline !! ")
  50. )
  51. )
  52.  
  53. (setq controle1 (length linha))
  54. (setq amostra '())
  55. (repeat controle1
  56. (setq x (caar linha))
  57. (if (= x 10)
  59. (setq item (car linha))
  60. (setq amostra (cons item amostra))
  61. (setq contador (1+ contador))
  62. )
  63. )
  64. (setq linha (cdr linha))
  65. )
  66. (setq amostra1 (reverse amostra))
  67. (if (= verif 1)
  68. (setq amostra (cons (car amostra1) amostra))
  69. (setq contador (1- contador))
  70. )
  71. (setq controle contador)
  72. (repeat controle
  73. (setq PTO1 (cdr(car amostra)))
  74. (setq PTO2 (cdr(car(cdr amostra))))
  75. (AZIMUTAR)
  76. (setq amostra(cdr amostra))
  77. )
  78. (command "undo" "end")
  79. (setvar "textsize" htext)
  80. (setvar"cmdecho" 1)
  82. )
  83.  
  84. (defun AZIMUTAR ()
  85. (setq A PTO1)
  86. (setq B PTO2)
  87. (setq C " - Az ")
  88. (setq D (angtos (angle A B)))
  89. (setq PALAV D)
  90. ;------------- MODIFICAÇÃO ROGÉRIO OPÇÃO AZIMUTE ----------------
  91. (setq E (strcat (rtos (distance A B) 2 2) "m"))
  92. (setq DADO E)
  93. (if (= opt "Y") (setq DADO (strcat E C PALAV)))
  94. ;---------------------------------------------------------- ------
  95. (PARALELO)
  96. (if (zerop (cdr (assoc 40 (entget (tblobjname "style" (getvar 'textstyle))))))
  97.   (command "_.-text" "_justify" "_mc" "_non" ponto_meio htext "_non" inicio dado)
  98.   (command "_.-text" "_justify" "_mc" "_non" ponto_meio "_non" inicio dado)
  99. )
  101. )
Logged

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: help with azimuth lisp
« Reply #19 on: November 20, 2016, 06:20:54 AM »
For reference: the original unmodified code.
« Last Edit: November 20, 2016, 10:09:55 AM by roy_043 »
Logged

pedroantonio

  • Guest
Re: help with azimuth lisp
« Reply #20 on: November 20, 2016, 09:18:17 AM »
Thank you  roy_043  i will try it
Logged

pedroantonio

  • Guest
Re: help with azimuth lisp
« Reply #21 on: November 20, 2016, 10:32:41 AM »
I update the code .

I add layer  and annotative text and is working

I still have problem with the angle calculation and the correct position of the text when the polyline is close (look the photos)

the angle problem is here
Quote
(setq D (angtos (angle A B)))


Code - Auto/Visual Lisp: [Select]
  1. ;;; ROTINA PARA COTAR E OU AZIMUTAR POLYLINES - TEXTO NO DESENHO = 2.34 ou 2.34 - Az 23°15/7"
  2. ;;; AS MEDIDAS APARECEM COMO FORAM DIGITADAS NO DESENHO (METROS, MILIMETROS, ETC)
  3. ;;; A ALTURA DO TEXTO E SOLICITADA NA EXECUCAO DA ROTINA E O STYLE E O CORRENTE
  4. ;;; ACERTAR ALTURA DO TEXTO DE ACORDO COM A ESCALA DE PLOTAGEM. PARA DEIXAR EM DEFAULT USE O COMMAND: TEXTSIZE
  5. ;;; Forum www.autolisp.com.br - Nome da rotina original: AZPOL - Autor: Orlei 29/08/2006
  6. ;;; Adaptacao: Rogerio Zanini e Marcio
  7. ;;;---------------------------------------------------------- ------------------------
  8.  
  9. (princ "\nDigite AP para iniciar - Verificar TextStyle corrente")
  10. (defun C:Ap ()
  11. (COMMAND "_layer" "_m" "_AZIMUTH" "_c" "150" "" "")
  12. (command "-style" "_TopoCad" "arial.ttf" "_annotative" "_yes" "_no" 2.5 1.0 0.0 "_no" "_no" "_no")
  13. ;---------------Sub-functions - Start-------------
  14. (defun PARALELO ()
  15. ;---------------------------------------------------------------
  16. (setq A1 (polar A (+ (/ pi 2)(angle B A )) (+ (* 0.05 2.5))))
  17. (setq B1 (polar B (+ (/ pi 2)(angle B A )) (+ (* 0.05 2.5))))
  18. ;--------------------------------------------------------------
  19. (setq ptx (/ (+ (car B1) (car A1)) 2))
  20. (setq pty (/ (+ (cadr B1) (cadr A1)) 2))
  21. (setq ponto_meio (list ptx pty))
  22. (if (< (car A1)(car B1))
  23. (setq inicio B1)
  24. (setq inicio A1)
  25. )
  26. )
  27. ;----------------Sub-functions - End -------------
  28. (setvar"cmdecho" 0)
  29. (setq flagv "falso")
  30. (setq controle 0)
  31. (setq controle1 0)
  32. (setq contador 0)
  33. (while (= flagv "falso")
  34. (setq mostre (entsel "\nSelecione a Polyline <2d> : "))
  35. (setq linha (entget (car mostre )))
  36. (setq verificador (cdr(assoc 0 linha)))
  37. (if (= verificador "LWPOLYLINE")
  39. (setq verif (cdr (assoc 70 linha)))
  40. (setq flagv "verdade")
  41. )
  42. (princ "\nNao e Polyline !! ")
  43. )
  44. )
  45. (setq controle1 (length linha))
  46. (setq amostra '())
  47. (repeat controle1
  48. (setq x (caar linha))
  49. (if (= x 10)
  51. (setq item (car linha))
  52. (setq amostra (cons item amostra))
  53. (setq contador (1+ contador))
  54. )
  55. )
  56. (setq linha (cdr linha))
  57. )
  58. (setq amostra1 (reverse amostra))
  59. (if (= verif 1)
  60. (setq amostra (cons (car amostra1) amostra))
  61. (setq contador (1- contador))
  62. )
  63. (setq controle contador)
  64. (repeat controle
  65. (setq PTO1 (cdr(car amostra)))
  66. (setq PTO2 (cdr(car(cdr amostra))))
  67. (AZIMUTAR)
  68. (setq amostra(cdr amostra))
  69. )
  70. (command "undo" "end")
  71. (setvar "textsize" 2.5)
  72. (setvar"cmdecho" 1)
  74. )
  75. ;---------------------------------------------------------
  76. (defun AZIMUTAR ()
  77. (setq A PTO1)
  78. (setq B PTO2)
  79. (setq C " - Az ")
  80. (setq D (angtos (angle A B)))
  81. (setq PALAV D)
  82. ;------------- MODIFICACAO ROGERIO OPCAO AZIMUTE ----------------
  83. (setq E (strcat (rtos (distance A B) 2 2) "m"))
  84. (setq DADO (strcat E C PALAV))
  85. ;---------------------------------------------------------- ------
  86. (PARALELO)
  87. (if (zerop (cdr (assoc 40 (entget (tblobjname "style" (getvar 'textstyle))))))
  88.   (command "_.-text" "_justify" "_Bc" "_non" ponto_meio 2.5 "_non" inicio dado)
  89.   (command "_.-text" "_justify" "_Bc" "_non" ponto_meio "_non" inicio dado)
  90. )
  92. )
  93.  
Logged

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: help with azimuth lisp
« Reply #22 on: November 20, 2016, 01:26:33 PM »
The angles are correct for CCW polylines.
For CW polylines you should use:
Code: [Select]
(setq D (angtos (angle B A)))
For CW polylines to get the texts as indicated in red:
Change:
Code: [Select]
(if (< (car A1)(car B1))
  (setq inicio B1)
  (setq inicio A1)
)To:
Code: [Select]
(setq inicio A1)
Logged

pedroantonio

  • Guest
Re: help with azimuth lisp
« Reply #23 on: November 20, 2016, 04:28:02 PM »
Thanks roy_043 . i update the code. the text look fine but the angles (in photo 2) is not correct

Code - Auto/Visual Lisp: [Select]
  1. ;;; ROTINA PARA COTAR E OU AZIMUTAR POLYLINES - TEXTO NO DESENHO = 2.34 ou 2.34 - Az 23°15/7"
  2. ;;; AS MEDIDAS APARECEM COMO FORAM DIGITADAS NO DESENHO (METROS, MILIMETROS, ETC)
  3. ;;; A ALTURA DO TEXTO E SOLICITADA NA EXECUCAO DA ROTINA E O STYLE E O CORRENTE
  4. ;;; ACERTAR ALTURA DO TEXTO DE ACORDO COM A ESCALA DE PLOTAGEM. PARA DEIXAR EM DEFAULT USE O COMMAND: TEXTSIZE
  5. ;;; Forum www.autolisp.com.br - Nome da rotina original: AZPOL - Autor: Orlei 29/08/2006
  6. ;;; Adaptacao: Rogerio Zanini e Marcio
  7. ;;;---------------------------------------------------------- ------------------------
  8. (defun C:Ap ()
  9. (COMMAND "_layer" "_m" "_AZIMUTH" "_c" "150" "" "")
  10. (command "-style" "_TopoCad" "arial.ttf" "_annotative" "_yes" "_no" 2.5 1.0 0.0 "_no" "_no" "_no")
  11. ;---------------Sub-functions - Start-------------
  12. (defun PARALELO ()
  13. ;---------------------------------------------------------------
  14. (setq A1 (polar A (+ (/ pi 2)(angle B A )) (+ (* 0.05 2.5))))
  15. (setq B1 (polar B (+ (/ pi 2)(angle B A )) (+ (* 0.05 2.5))))
  16. ;--------------------------------------------------------------
  17. (setq ptx (/ (+ (car B1) (car A1)) 2))
  18. (setq pty (/ (+ (cadr B1) (cadr A1)) 2))
  19. (setq ponto_meio (list ptx pty))
  20. ;(if (< (car A1)(car B1))
  21. ;(setq inicio B1)
  22. (setq inicio A1)
  23. ;)
  24. )
  25. ;----------------Sub-functions - End -------------
  26. (setvar"cmdecho" 0)
  27. (setq flagv "falso")
  28. (setq controle 0)
  29. (setq controle1 0)
  30. (setq contador 0)
  31. (while (= flagv "falso")
  32. (setq mostre (entsel "\nSelecione a Polyline <2d> : "))
  33. (setq linha (entget (car mostre )))
  34. (setq verificador (cdr(assoc 0 linha)))
  35. (if (= verificador "LWPOLYLINE")
  37. (setq verif (cdr (assoc 70 linha)))
  38. (setq flagv "verdade")
  39. )
  40. (princ "\nNao e Polyline !! ")
  41. )
  42. )
  43. (setq controle1 (length linha))
  44. (setq amostra '())
  45. (repeat controle1
  46. (setq x (caar linha))
  47. (if (= x 10)
  49. (setq item (car linha))
  50. (setq amostra (cons item amostra))
  51. (setq contador (1+ contador))
  52. )
  53. )
  54. (setq linha (cdr linha))
  55. )
  56. (setq amostra1 (reverse amostra))
  57. (if (= verif 1)
  58. (setq amostra (cons (car amostra1) amostra))
  59. (setq contador (1- contador))
  60. )
  61. (setq controle contador)
  62. (repeat controle
  63. (setq PTO1 (cdr(car amostra)))
  64. (setq PTO2 (cdr(car(cdr amostra))))
  65. (AZIMUTAR)
  66. (setq amostra(cdr amostra))
  67. )
  68. (command "undo" "end")
  69. (setvar "textsize" 2.5)
  70. (setvar"cmdecho" 1)
  72. )
  73. ;---------------------------------------------------------
  74. (defun AZIMUTAR ()
  75. (setq A PTO1)
  76. (setq B PTO2)
  77. (setq C " - Az ")
  78. (setq D (angtos (angle B A)))
  79. (setq PALAV D)
  80. ;------------- MODIFICACAO ROGERIO OPCAO AZIMUTE ----------------
  81. (setq E (strcat (rtos (distance A B) 2 2) "m"))
  82. (setq DADO (strcat E C PALAV))
  83. ;---------------------------------------------------------- ------
  84. (PARALELO)
  85. (if (zerop (cdr (assoc 40 (entget (tblobjname "style" (getvar 'textstyle))))))
  86.   (command "_.-text" "_justify" "_Bc" "_non" ponto_meio 2.5 "_non" inicio dado)
  87.   (command "_.-text" "_justify" "_Bc" "_non" ponto_meio "_non" inicio dado)
  88. )
  90. )
  91.  
Logged

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: help with azimuth lisp
« Reply #24 on: November 21, 2016, 04:02:52 AM »
My test with your code and a CW polyline similar to your second example shows angles that are correct.

But your code will have to address the direction of the polyline anyway. Not all polylines are CW.
Logged

pedroantonio

  • Guest
Re: help with azimuth lisp
« Reply #25 on: November 21, 2016, 04:32:14 AM »
Hi roy_043 it was mine mistake .your code works fine.

Thank you for your time.
Logged
Pages: 1 [2]  All |   Go Up
« previous next »