Author Topic: Entmake Text with Arrow  (Read 357 times)

0 Members and 1 Guest are viewing this topic.

Dilan

  • Mosquito
  • Posts: 10
Entmake Text with Arrow
« on: November 05, 2018, 04:48:50 PM »
Hey.

Please help me, how can I put the text under the arrow?

Code: [Select]
(defun c:text_! ()
(while
(setq p1 (getpoint (strcat "\nFirst point  ->>")))
(setq p2 (getpoint p1 (strcat "\nSecond point  ->>")))

(setq      *ht* 0.5
           di (/ (* *ht* 0.45) 0.5)
           nm (trans '(0. 0. 1.) 1 0 t)
           )
(setq a (angle p1 p2))

(entmake
     (list
'(0 . "TEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
'(10 0. 0. 0.)
(cons 40 *ht*)
(cons 7 (getvar 'textstyle))
(cons 8 "Some layer")
(cons 62 1)
(cons 1 "Some string")
(cons 50
       (if (minusp (cos a))
(+ pi a)
a
       )
)
'(72 . 1)
  (cons 11 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.)) p1 p2))
'(73 . 1)
       )
     ) ; end of entmake

 (entmake
           (list
              '(0 . "LWPOLYLINE")
              '(100 . "AcDbEntity")
              '(100 . "AcDbPolyline")
              '(90 . 3)
              '(70 . 0)
               (cons 8 "Some layer")
   (cons 10 (trans p2 1 nm))
              '(40 . 0.0)
               (cons 41 (/ di 2.0))
               (cons 62 21)
   (cons 10 (trans (polar p2 (angle p2 p1) di) 1 nm))
               (cons 10 (trans p1 1 nm))
               (cons 210 nm)
           )
       ) ; end of entmake
)
(princ)
)

efernal

  • Newt
  • Posts: 190
Re: Entmake Text with Arrow
« Reply #1 on: November 16, 2018, 12:34:30 PM »
Code - Auto/Visual Lisp: [Select]
  1. (DEFUN c:tarrow (/ p1 p2 *ht* di nm a)
  2.  (WHILE (SETQ p1 (GETPOINT (STRCAT "\nFirst point  ->>")))
  3.    (SETQ p2 (GETPOINT p1 (STRCAT "\nSecond point  ->>")))
  4.    (SETQ *ht* 0.5
  5.          di   (/ (* *ht* 0.45) 0.5)
  6.          nm   (TRANS '(0.0 0.0 1.0) 1 0 T)
  7.          a    (ANGLE p1 p2)
  8.    )
  9.    (ENTMAKE (LIST (CONS 0 "TEXT")
  10.                   (CONS 100 "AcDbEntity")
  11.                   (CONS 100 "AcDbText")
  12.                   (CONS 10 (LIST 0. 0. 0.))
  13.                   (CONS 40 *ht*)
  14.                   (CONS 7 (GETVAR 'textstyle))
  15.                   (CONS 8 "Some layer")
  16.                   (CONS 62 1)
  17.                   (CONS 1 "Some string")
  18.                   (CONS 50
  19.                         (IF (MINUSP (COS a))
  20.                           (+ PI a)
  21.                           a
  22.                         )
  23.                   )
  24.                   (CONS 72 1)
  25.                   (CONS 11 (LIST (/ (+ (CAR p1) (CAR p2)) 2.0) (/ (+ (CADR p1) (CADR p2)) 2.0) 0.0))
  26.                   (CONS 73 1)
  27.             )
  28.    )
  29.    (ENTMAKE (LIST (CONS 0 "LWPOLYLINE")
  30.                   (CONS 100 "AcDbEntity")
  31.                   (CONS 100 "AcDbPolyline")
  32.                   (CONS 90 3)
  33.                   (CONS 70 0)
  34.                   (CONS 8 "Some layer")
  35.                   (CONS 10 (TRANS p2 1 nm))
  36.                   (CONS 40 0.0)
  37.                   (CONS 41 (/ di 2.0))
  38.                   (CONS 62 21)
  39.                   (CONS 10 (TRANS (POLAR p2 (ANGLE p2 p1) di) 1 nm))
  40.                   (CONS 10 (TRANS p1 1 nm))
  41.                   (CONS 210 nm)
  42.             )
  43.    )
  44.  )
  45.  (PRINC)
  46. )
e.fernal

efernal

  • Newt
  • Posts: 190
Re: Entmake Text with Arrow
« Reply #2 on: November 16, 2018, 12:50:39 PM »
Better...
Code - Auto/Visual Lisp: [Select]
  1. (DEFUN c:tarrow (/ p1 p2 di nm a str)
  2.  (IF (OR (NOT g:tarrow:hf) (NOT (NUMBERP g:tarrow:hf)) (NOT (> g:tarrow:hf 0.0)))
  3.    (SETQ g:tarrow:hf 5.0)
  4.  )
  5.  (INITGET 6)
  6.  (SETQ hf (GETREAL (STRCAT "\n-> Altura da fonte < " (RTOS g:tarrow:hf 2 2) " > : "))) ; FONT HEIGHT
  7.  (IF (> hf 0.0)
  8.    (SETQ g:tarrow:hf hf)
  9.  )
  10.  (WHILE (SETQ p1 (GETPOINT "\n-> Clique no primeiro ponto :")) ; FIRST POINT
  11.    (IF (SETQ p2 (GETPOINT p1 "\r-> Clique no ponto final :     ")) ; SECOND POINT
  12.      (PROGN (SETQ di  (/ (* g:tarrow:hf 0.45) 0.5)
  13.                   nm  (TRANS '(0.0 0.0 1.0) 1 0 T)
  14.                   a   (ANGLE p1 p2)
  15.                   str ""
  16.             )
  17.             (ENTMAKE (LIST (CONS 0 "LWPOLYLINE")
  18.                            (CONS 100 "AcDbEntity")
  19.                            (CONS 100 "AcDbPolyline")
  20.                            (CONS 90 3)
  21.                            (CONS 70 0)
  22.                            (CONS 8 "Texto e Seta")
  23.                            (CONS 10 (TRANS p2 1 nm))
  24.                            (CONS 40 0.0)
  25.                            (CONS 41 (/ di 2.0))
  26.                            (CONS 62 21)
  27.                            (CONS 10 (TRANS (POLAR p2 (ANGLE p2 p1) di) 1 nm))
  28.                            (CONS 10 (TRANS p1 1 nm))
  29.                            (CONS 210 nm)
  30.                      )
  31.             )
  32.             (WHILE (AND (NOT (> (STRLEN str) 0)) (NOT (WCMATCH str "*#*@*")) (NOT (WCMATCH str "*@*#*")))
  33.               (SETQ str (GETSTRING "\r-> Texto a escrever : " T)) ; GIVE ME A STRING
  34.             )
  35.             (ENTMAKE (LIST (CONS 0 "TEXT")
  36.                            (CONS 100 "AcDbEntity")
  37.                            (CONS 100 "AcDbText")
  38.                            (CONS 10 (LIST 0. 0. 0.))
  39.                            (CONS 40 g:tarrow:hf)
  40.                            (CONS 8 "Texto e Seta")
  41.                            (CONS 62 1)
  42.                            (CONS 1 str)
  43.                            (CONS 50
  44.                                  (IF (MINUSP (COS a))
  45.                                    (+ PI a)
  46.                                    a
  47.                                  )
  48.                            )
  49.                            (CONS 72 1)
  50.                            (CONS 11 (LIST (/ (+ (CAR p1) (CAR p2)) 2.0) (/ (+ (CADR p1) (CADR p2)) 2.0) 0.0))
  51.                            (CONS 73 1)
  52.                      )
  53.             )
  54.      )
  55.    )
  56.  )
  57.  (PRINC)
  58. )
e.fernal

Dilan

  • Mosquito
  • Posts: 10
Re: Entmake Text with Arrow
« Reply #3 on: November 16, 2018, 05:37:24 PM »
Better...
Code - Auto/Visual Lisp: [Select]
  1. (DEFUN c:tarrow (/ p1 p2 di nm a str)
  2.  (IF (OR (NOT g:tarrow:hf) (NOT (NUMBERP g:tarrow:hf)) (NOT (> g:tarrow:hf 0.0)))
  3.    (SETQ g:tarrow:hf 5.0)
  4.  )
  5.  (INITGET 6)
  6.  (SETQ hf (GETREAL (STRCAT "\n-> Altura da fonte < " (RTOS g:tarrow:hf 2 2) " > : "))) ; FONT HEIGHT
  7.  (IF (> hf 0.0)
  8.    (SETQ g:tarrow:hf hf)
  9.  )
  10.  (WHILE (SETQ p1 (GETPOINT "\n-> Clique no primeiro ponto :")) ; FIRST POINT
  11.    (IF (SETQ p2 (GETPOINT p1 "\r-> Clique no ponto final :     ")) ; SECOND POINT
  12.      (PROGN (SETQ di  (/ (* g:tarrow:hf 0.45) 0.5)
  13.                   nm  (TRANS '(0.0 0.0 1.0) 1 0 T)
  14.                   a   (ANGLE p1 p2)
  15.                   str ""
  16.             )
  17.             (ENTMAKE (LIST (CONS 0 "LWPOLYLINE")
  18.                            (CONS 100 "AcDbEntity")
  19.                            (CONS 100 "AcDbPolyline")
  20.                            (CONS 90 3)
  21.                            (CONS 70 0)
  22.                            (CONS 8 "Texto e Seta")
  23.                            (CONS 10 (TRANS p2 1 nm))
  24.                            (CONS 40 0.0)
  25.                            (CONS 41 (/ di 2.0))
  26.                            (CONS 62 21)
  27.                            (CONS 10 (TRANS (POLAR p2 (ANGLE p2 p1) di) 1 nm))
  28.                            (CONS 10 (TRANS p1 1 nm))
  29.                            (CONS 210 nm)
  30.                      )
  31.             )
  32.             (WHILE (AND (NOT (> (STRLEN str) 0)) (NOT (WCMATCH str "*#*@*")) (NOT (WCMATCH str "*@*#*")))
  33.               (SETQ str (GETSTRING "\r-> Texto a escrever : " T)) ; GIVE ME A STRING
  34.             )
  35.             (ENTMAKE (LIST (CONS 0 "TEXT")
  36.                            (CONS 100 "AcDbEntity")
  37.                            (CONS 100 "AcDbText")
  38.                            (CONS 10 (LIST 0. 0. 0.))
  39.                            (CONS 40 g:tarrow:hf)
  40.                            (CONS 8 "Texto e Seta")
  41.                            (CONS 62 1)
  42.                            (CONS 1 str)
  43.                            (CONS 50
  44.                                  (IF (MINUSP (COS a))
  45.                                    (+ PI a)
  46.                                    a
  47.                                  )
  48.                            )
  49.                            (CONS 72 1)
  50.                            (CONS 11 (LIST (/ (+ (CAR p1) (CAR p2)) 2.0) (/ (+ (CADR p1) (CADR p2)) 2.0) 0.0))
  51.                            (CONS 73 1)
  52.                      )
  53.             )
  54.      )
  55.    )
  56.  )
  57.  (PRINC)
  58. )
But the text is also above the arrow and not under it.
Is it possible to do it like in the picture?

efernal

  • Newt
  • Posts: 190
Re: Entmake Text with Arrow
« Reply #4 on: November 17, 2018, 07:08:04 AM »
Ok, done...
Code - Auto/Visual Lisp: [Select]
  1. (DEFUN c:tarrow (/ p1 p2 di nm a str hf p11)
  2.  (IF (OR (NOT g:tarrow:hf) (NOT (NUMBERP g:tarrow:hf)) (NOT (> g:tarrow:hf 0.0)))
  3.    (SETQ g:tarrow:hf 5.0)
  4.  )
  5.  (INITGET 6)
  6.  (SETQ hf (GETREAL (STRCAT "\n-> Altura da fonte < " (RTOS g:tarrow:hf 2 2) " > : "))) ; FONT HEIGHT = altura da fonte
  7.  (IF (> hf 0.0)
  8.    (SETQ g:tarrow:hf hf)
  9.  )
  10.  (WHILE (SETQ p1 (GETPOINT "\n-> Clique no primeiro ponto :")) ; FIRST POINT = Give a first point
  11.    (IF (SETQ p2 (GETPOINT p1 "\r-> Clique no ponto final :     ")) ; SECOND POINT = Now give me a second point
  12.      (PROGN (SETQ di  (/ (* g:tarrow:hf 0.45) 0.5)
  13.                   nm  (TRANS '(0.0 0.0 1.0) 1 0 T)
  14.                   a   (ANGLE p1 p2)
  15.                   str ""
  16.                   p11 (POLAR (POLAR p1 (ANGLE p1 p2) (/ (DISTANCE p1 p2) 2.0)) (- a (* PI 0.5)) (/ g:tarrow:hf 5.0))
  17.             )
  18.             (ENTMAKE (LIST (CONS 0 "LWPOLYLINE")
  19.                            (CONS 100 "AcDbEntity")
  20.                            (CONS 100 "AcDbPolyline")
  21.                            (CONS 90 3)
  22.                            (CONS 70 0)
  23.                            (CONS 8 "Texto e Seta") ; Text and arrow
  24.                            (CONS 10 (TRANS p2 1 nm))
  25.                            (CONS 40 0.0)
  26.                            (CONS 41 (/ di 2.0))
  27.                            (CONS 62 21)
  28.                            (CONS 10 (TRANS (POLAR p2 (ANGLE p2 p1) di) 1 nm))
  29.                            (CONS 10 (TRANS p1 1 nm))
  30.                            (CONS 210 nm)
  31.                      )
  32.             )
  33.             (WHILE (AND (NOT (> (STRLEN str) 0)) (NOT (WCMATCH str "*#*@*")) (NOT (WCMATCH str "*@*#*")))
  34.               (SETQ str (GETSTRING "\r-> Texto a escrever : " T)) ; Give me a string
  35.             )
  36.             (ENTMAKE (LIST (CONS 0 "TEXT")
  37.                            (CONS 100 "AcDbEntity")
  38.                            (CONS 100 "AcDbText")
  39.                            (CONS 10 (LIST 0. 0. 0.))
  40.                            (CONS 40 g:tarrow:hf)
  41.                            (CONS 8 "Texto e Seta") ; Text and arrow
  42.                            (CONS 62 1)
  43.                            (CONS 1 str)
  44.                            (CONS 50
  45.                                  (IF (MINUSP (COS a))
  46.                                    (+ PI a)
  47.                                    a
  48.                                  )
  49.                            )
  50.                            (CONS 72 1)
  51.                            (CONS 11 p11)
  52.                            (CONS 73 3)
  53.                      )
  54.             )
  55.      )
  56.    )
  57.  )
  58.  (PRINC)
  59. )
  60. ;|«Visual LISP© Format Options»
  61. (140 2 40 2 nil "end of " 100 9 2 1 0 nil nil nil T)
  62. ;*** DO NOT add text below the comment! ***|;
e.fernal

efernal

  • Newt
  • Posts: 190
Re: Entmake Text with Arrow
« Reply #5 on: November 17, 2018, 07:15:26 AM »
Code - Auto/Visual Lisp: [Select]
  1. ;; please, subst this
  2.  
  3. (SETQ di  (/ (* g:tarrow:hf 0.45) 0.5)
  4.                   nm  (TRANS '(0.0 0.0 1.0) 1 0 T)
  5.                   a   (ANGLE p1 p2)
  6.                   str ""
  7.                   p11 (POLAR (POLAR p1 (ANGLE p1 p2) (/ (DISTANCE p1 p2) 2.0)) (- a (* PI 0.5)) (/ g:tarrow:hf 5.0))
  8.             )
  9.  
  10. ;;for this
  11.  
  12. (SETQ di  (/ (* g:tarrow:hf 0.45) 0.5)
  13.                   nm  (TRANS '(0.0 0.0 1.0) 1 0 T)
  14.                   a   (ANGLE p1 p2)
  15.                   str ""
  16.                   p11 (IF (AND (> a (* PI 0.5)) (< a (* PI 1.5)))
  17.                         (POLAR (POLAR p1 (ANGLE p1 p2) (/ (DISTANCE p1 p2) 2.0)) (+ a (* PI 0.5)) (/ g:tarrow:hf 5.0))
  18.                         (POLAR (POLAR p1 (ANGLE p1 p2) (/ (DISTANCE p1 p2) 2.0)) (- a (* PI 0.5)) (/ g:tarrow:hf 5.0))
  19.                       )
  20.             )
e.fernal

Dilan

  • Mosquito
  • Posts: 10
Re: Entmake Text with Arrow
« Reply #6 on: November 17, 2018, 05:24:20 PM »
Ok, done...
Code - Auto/Visual Lisp: [Select]
  1. (DEFUN c:tarrow (/ p1 p2 di nm a str hf p11)
  2.  (IF (OR (NOT g:tarrow:hf) (NOT (NUMBERP g:tarrow:hf)) (NOT (> g:tarrow:hf 0.0)))
  3.    (SETQ g:tarrow:hf 5.0)
  4.  )
  5.  (INITGET 6)
  6.  (SETQ hf (GETREAL (STRCAT "\n-> Altura da fonte < " (RTOS g:tarrow:hf 2 2) " > : "))) ; FONT HEIGHT = altura da fonte
  7.  (IF (> hf 0.0)
  8.    (SETQ g:tarrow:hf hf)
  9.  )
  10.  (WHILE (SETQ p1 (GETPOINT "\n-> Clique no primeiro ponto :")) ; FIRST POINT = Give a first point
  11.    (IF (SETQ p2 (GETPOINT p1 "\r-> Clique no ponto final :     ")) ; SECOND POINT = Now give me a second point
  12.      (PROGN (SETQ di  (/ (* g:tarrow:hf 0.45) 0.5)
  13.                   nm  (TRANS '(0.0 0.0 1.0) 1 0 T)
  14.                   a   (ANGLE p1 p2)
  15.                   str ""
  16.                   p11 (POLAR (POLAR p1 (ANGLE p1 p2) (/ (DISTANCE p1 p2) 2.0)) (- a (* PI 0.5)) (/ g:tarrow:hf 5.0))
  17.             )
  18.             (ENTMAKE (LIST (CONS 0 "LWPOLYLINE")
  19.                            (CONS 100 "AcDbEntity")
  20.                            (CONS 100 "AcDbPolyline")
  21.                            (CONS 90 3)
  22.                            (CONS 70 0)
  23.                            (CONS 8 "Texto e Seta") ; Text and arrow
  24.                            (CONS 10 (TRANS p2 1 nm))
  25.                            (CONS 40 0.0)
  26.                            (CONS 41 (/ di 2.0))
  27.                            (CONS 62 21)
  28.                            (CONS 10 (TRANS (POLAR p2 (ANGLE p2 p1) di) 1 nm))
  29.                            (CONS 10 (TRANS p1 1 nm))
  30.                            (CONS 210 nm)
  31.                      )
  32.             )
  33.             (WHILE (AND (NOT (> (STRLEN str) 0)) (NOT (WCMATCH str "*#*@*")) (NOT (WCMATCH str "*@*#*")))
  34.               (SETQ str (GETSTRING "\r-> Texto a escrever : " T)) ; Give me a string
  35.             )
  36.             (ENTMAKE (LIST (CONS 0 "TEXT")
  37.                            (CONS 100 "AcDbEntity")
  38.                            (CONS 100 "AcDbText")
  39.                            (CONS 10 (LIST 0. 0. 0.))
  40.                            (CONS 40 g:tarrow:hf)
  41.                            (CONS 8 "Texto e Seta") ; Text and arrow
  42.                            (CONS 62 1)
  43.                            (CONS 1 str)
  44.                            (CONS 50
  45.                                  (IF (MINUSP (COS a))
  46.                                    (+ PI a)
  47.                                    a
  48.                                  )
  49.                            )
  50.                            (CONS 72 1)
  51.                            (CONS 11 p11)
  52.                            (CONS 73 3)
  53.                      )
  54.             )
  55.      )
  56.    )
  57.  )
  58.  (PRINC)
  59. )
  60. ;|«Visual LISP© Format Options»
  61. (140 2 40 2 nil "end of " 100 9 2 1 0 nil nil nil T)
  62. ;*** DO NOT add text below the comment! ***|;
Thank you very much efernal, this is what I need.

efernal

  • Newt
  • Posts: 190
Re: Entmake Text with Arrow
« Reply #7 on: November 18, 2018, 09:41:24 AM »
Code - Auto/Visual Lisp: [Select]
  1. ;; need a correction
  2.  
  3. p11 (IF (AND (> a (* PI 0.5)) (< a (* PI 1.5)))
  4.  
  5. ;;to
  6.  
  7. p11 (IF (AND (> a (* PI 0.5)) (<= a (* PI 1.5)))
  8.  
  9.  
e.fernal