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

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

0 Members and 1 Guest are viewing this topic.

Dilan

  • Newt
  • Posts: 23
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)
)
Logged

efernal

  • Bull Frog
  • Posts: 206
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. )
Logged
e.fernal

efernal

  • Bull Frog
  • Posts: 206
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. )
Logged
e.fernal

Dilan

  • Newt
  • Posts: 23
Re: Entmake Text with Arrow
« Reply #3 on: November 16, 2018, 05:37:24 PM »
Quote from: efernal 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. )
But the text is also above the arrow and not under it.
Is it possible to do it like in the picture?
Logged

efernal

  • Bull Frog
  • Posts: 206
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! ***|;
Logged
e.fernal

efernal

  • Bull Frog
  • Posts: 206
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.              )
Logged
e.fernal

Dilan

  • Newt
  • Posts: 23
Re: Entmake Text with Arrow
« Reply #6 on: November 17, 2018, 05:24:20 PM »
Quote from: efernal 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! ***|;
Thank you very much efernal, this is what I need.
Logged

efernal

  • Bull Frog
  • Posts: 206
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.  
Logged
e.fernal
Pages: [1] |   Go Up
« previous next »