Add a new Point to the end of the Polyline near MText/Text

May 31

Good day Gentlemen,

I need a LISP like this, Add a new Point to the end of the Polyline near MText/Text

I have attached dwg example file

Could you please help me with this?

May 31

Bit busy but get all the text then do bounding box plus a small offset, then look for pline touching box, then add a Point. Some one else my jump in.

June 1

I have such a lisp, prepared by master Alimuna.
But it doesn't work exactly as I want.

(defun c:test (/ dc ss ln lm e k s0 ts t0 tn tp ld ls)
            (vl-load-com)
  (if (and (setq dc (vla-get-ActiveDocument
               (vlax-get-acad-object))
          ss (ssget '((0 . "LwPolyline") (8 . "GLine"))))
        (setq ln (getstring T "\nEnter the layer name:")))
    (progn (vla-StartUndomark dc)
      (repeat (setq k (sslength ss))
        (setq k (1- k)
          s0 (ssname ss k)
            ts (ssget "_X" '((0 . "*Text") (8 . "GText")))
              ls nil)
        (repeat (setq e (sslength ts))
          (setq e (1- e)
            t0 (ssname ts e)
              tn (entget t0)
                tp (cdr (assoc 10 tn))
            ls (cons (list (distance tp
                 (vlax-curve-getClosestPointTo
                   (vlax-ename->vla-object s0) tp T)) tp
                 (atof (getpropertyvalue t0
                   (if (= (cdr (assoc 0 tn)) "MTEXT")
                     "Text" "TextString"))) t0) ls))
         )
         (setq ld (car (vl-sort ls '(lambda(a b)
             (< (car a) (car b)))))
           lm (if (= ln "") (getvar "Clayer") ln)
             tm (entget (nth 3 ld)))
         (entmake (list '(0 . "Point") (cons 8 lm)
           (cons 10 (append (cadar (vl-sort (mapcar '(lambda(a)
              (list (distance (cadr ld) a) a))
                (mapcar 'cdr (vl-remove-if '(lambda(x)
                  (/= (car x) 10)) (entget s0))))
              '(lambda(a b) (> (car a) (car b)))))
                 (list (caddr ld))))))
         (entmod (subst (cons 8 lm) (assoc 8 tm) tm))
      ) (vla-EndUndomark dc)
    )
  ) (prin1)
)

June 3

Mr. @Tsuky Could you please help this?

June 3

You can try this:

(defun c:test ( / ss_text n dxf_txt z p10 ang s_ang c_ang ss_box pt_lst ent dxf_lw pt_ins)
  (setq ss_text (ssget '((0 . "TEXT") (8 . "GText"))))
  (cond
    (ss_text
      (repeat (setq n (sslength ss_text))
        (setq
          dxf_txt (entget (ssname ss_text (setq n (1- n))))
          z (atof (cdr (assoc 1 dxf_txt)))
          p10 (cdr (assoc 10 dxf_txt))
          ang (cdr (assoc 50 dxf_txt))
          s_ang (sin ang)
          c_ang (cos ang)
          ss_box (textbox dxf_txt)
          pt_lst
          (mapcar
            '(lambda (l / )
              (list
                (+ (car p10) (- (* (car l) c_ang) (* (cadr l) s_ang)))
                (+ (cadr p10) (+ (* (car l) s_ang) (* (cadr l) c_ang)))
              )
            )
            (list (car ss_box) (cadr ss_box))
          )
          ss_pl
          (ssget "_C"
            (mapcar '- (car pt_lst) (list (* (getvar "TEXTSIZE") 0.25) (* (getvar "TEXTSIZE") 0.25)))
            (mapcar '+ (cadr pt_lst) (list (* (getvar "TEXTSIZE") 0.25) (* (getvar "TEXTSIZE") 0.25)))
            '((0 . "LWPOLYLINE") (8 . "GLine"))
          )
        )
        (cond
          ((and ss_pl (eq (sslength ss_pl) 1))
            (setq
              ent (ssname ss_pl 0)
              dxf_lw (entget ent)
              pt_ins (cdr (assoc 10 dxf_lw))
            )
            (cond
              ((and z pt_ins)
                (mapcar
                  '(lambda (x y)
                    (if (not (tblsearch "LAYER" x))
                      (entmake
                        (list
                          '(0 . "LAYER")
                          '(100 . "AcDbSymbolTableRecord")
                          '(100 . "AcDbLayerTableRecord")
                          (cons 2 x)
                          '(70 . 0)
                          (cons 62 y)
                          '(6 . "Continuous")
                          '(290 . 1)
                          '(370 . -3)
                        )
                      )
                    )
                  )
                  '("GLine2" "GPoint2" "GText2")
                  '(2 5 1)
                )
                (entmod (subst (cons 8 "GLine2") (assoc 8 dxf_lw) dxf_lw))
                (entmod (subst (cons 8 "GText2") (assoc 8 dxf_txt) dxf_txt))
                (entmake
                  (list
                    '(0 . "POINT")
                    '(100 . "AcDbEntity")
                    '(67 . 0)
                    '(410 . "Model")
                    '(8 . "GPoint2")
                    '(100 . "AcDbPoint")
                    (cons 10 (list (car pt_ins) (cadr pt_ins) z))
                    '(210 0.0 0.0 1.0)
                    '(50 . 0.0)
                  )
                )
                (setq z nil pt_ins nil sspl nil)
              )
            )
          )
          (T (setq z nil pt_ins nil sspl nil))
        )
      )
    )
  )
  (prin1)
)

June 3

Good day Mr Tsuky,

I have checked very good job thank you very much,

just I have a small comment in red cloud.

Could you please see attached dwg file rev2.

Point to Text-Polyline rev2.dwg

Edited June 3 by macros55

June 3

In fact, I noticed this malfunction before publishing my response.
I looked for something in the code that could do this without processing, but I couldn't find it.
By restarting the function on the unprocessed texts, they are then processed correctly.
Sorry but I can't find the cause in my code that creates this malfunction.
Do any other commenters have an idea?
I think we need to look into (ssget '_C' pt_inf pt_supp '(.....)), I tried several things, without convincing results.
Graphical selections are often problematic: (zooming to entity first in code before selection?)

June 3

Indeed zooming Object seems to solve the problem, but slows down the process.

(defun c:test ( / ss_text n dxf_txt z p10 ang s_ang c_ang ss_box pt_lst ent dxf_lw pt_ins)
  (setq ss_text (ssget '((0 . "TEXT") (8 . "GText"))))
  (cond
    (ss_text
      (setvar "cmdecho" 0)
      (repeat (setq n (sslength ss_text))
        (setq
          dxf_txt (entget (ssname ss_text (setq n (1- n))))
          z (atof (cdr (assoc 1 dxf_txt)))
          p10 (cdr (assoc 10 dxf_txt))
          ang (cdr (assoc 50 dxf_txt))
          s_ang (sin ang)
          c_ang (cos ang)
          ss_box (textbox dxf_txt)
          pt_lst
          (mapcar
            '(lambda (l / )
              (list
                (+ (car p10) (- (* (car l) c_ang) (* (cadr l) s_ang)))
                (+ (cadr p10) (+ (* (car l) s_ang) (* (cadr l) c_ang)))
              )
            )
            (list (car ss_box) (cadr ss_box))
          )
        )
        (command "_.zoom" "_object" (cdar dxf_txt) "")
        (setq
          ss_pl
          (ssget "_C"
            (mapcar '- (car pt_lst) (list (* (getvar "TEXTSIZE") 0.25) (* (getvar "TEXTSIZE") 0.25)))
            (mapcar '+ (cadr pt_lst) (list (* (getvar "TEXTSIZE") 0.25) (* (getvar "TEXTSIZE") 0.25)))
            '((0 . "LWPOLYLINE") (8 . "GLine"))
          )
        )
        (cond
          ((and ss_pl (eq (sslength ss_pl) 1))
            (setq
              ent (ssname ss_pl 0)
              dxf_lw (entget ent)
              pt_ins (cdr (assoc 10 dxf_lw))
            )
            (cond
              ((and z pt_ins)
                (mapcar
                  '(lambda (x y)
                    (if (not (tblsearch "LAYER" x))
                      (entmake
                        (list
                          '(0 . "LAYER")
                          '(100 . "AcDbSymbolTableRecord")
                          '(100 . "AcDbLayerTableRecord")
                          (cons 2 x)
                          '(70 . 0)
                          (cons 62 y)
                          '(6 . "Continuous")
                          '(290 . 1)
                          '(370 . -3)
                        )
                      )
                    )
                  )
                  '("GLine2" "GPoint2" "GText2")
                  '(2 5 1)
                )
                (entmod (subst (cons 8 "GLine2") (assoc 8 dxf_lw) dxf_lw))
                (entmod (subst (cons 8 "GText2") (assoc 8 dxf_txt) dxf_txt))
                (entmake
                  (list
                    '(0 . "POINT")
                    '(100 . "AcDbEntity")
                    '(67 . 0)
                    '(410 . "Model")
                    '(8 . "GPoint2")
                    '(100 . "AcDbPoint")
                    (cons 10 (list (car pt_ins) (cadr pt_ins) z))
                    '(210 0.0 0.0 1.0)
                    '(50 . 0.0)
                  )
                )
                (setq z nil pt_ins nil sspl nil)
              )
            )
          )
          (T (setq z nil pt_ins nil sspl nil))
        )
      )
      (setvar "cmdecho" 1)
    )
  )
  (prin1)
)

June 4

Tsuky, micro seconds use pt in mapcar textsize does not change.

(setq pt (list (* (getvar "TEXTSIZE") 0.25) (* (getvar "TEXTSIZE") 0.25))))

Not sure if faster ZOOM C PT scale rather than object. Another to try Osmode 0, I am pretty sure have found objects no need to zoom, that may be Osnap kicking in.

June 4

6 hours ago, Tsuky said:
)

Gentlemen,

LIPS is recognize only TEXT,
Sometimes it is necessary to don't explode for MTEXT.
is it possible to recognize also MTEXT along with TEXT?
I added a different but also a bit complicated file to try,

Mr Tsuky Could you please take a look? dwg rev3

Point to Text-Polyline rev3.dwg

June 4

Your file is not homogeneous:
Texts, mtexts with fancy formatting in the text itself
Polylines with different origins (when they are not simple lines)
Since I'm not a magician, I suggest the following (which seems to do most of the work).
It's not perfect, but I wouldn't do more for free.
The treatment is long (around twenty minutes), a progress bar is displayed.

(defun c:test ( / ss_text size i n dxf_txt str l_str p10 ang z pt_lst ent dxf_lw l_vtx pt_ins)
  (setvar "CMDECHO" 0)
  (mapcar
    '(lambda (x / lay)
      (setq lay (entget (tblobjname "LAYER" x)))
      (entmod
        (subst
          (cons 70 0)
          (assoc 70 lay)
          (subst
            (cons 62 (abs (cdr (assoc 62 lay))))
            (assoc 62 lay)
            lay
          )
        )
      )
    )
    '("GLine" "GText")
  )
  (mapcar
    '(lambda (x y)
      (if (not (tblsearch "LAYER" x))
        (entmake
          (list
            '(0 . "LAYER")
            '(100 . "AcDbSymbolTableRecord")
            '(100 . "AcDbLayerTableRecord")
            (cons 2 x)
            '(70 . 0)
            (cons 62 y)
            '(6 . "Continuous")
            '(290 . 1)
            '(370 . -3)
          )
        )
      )
    )
    '("GLine2" "GPoint2" "GText2")
    '(2 5 1)
  )
  (command "_.zoom" "_extent")
  (setq ss_text (ssget '((0 . "*TEXT") (8 . "GText"))))
  (cond
    (ss_text
      (setvar "PDMODE" 68)
      (setvar "PDSIZE" 1)
      (setq size (sslength ss_text) i 0)
      (acet-ui-progress-init "Working:" size)
      (repeat (setq n (sslength ss_text))
        (acet-ui-progress-safe (setq i (1+ i)))
        (setq
          dxf_txt (entget (ssname ss_text (setq n (1- n))))
          str (cdr (assoc 1 dxf_txt))
        )
        (if (and (eq (cdr (assoc 0 dxf_txt)) "MTEXT") (vl-string-position 59 str nil T))
          (setq str (substr str (+ 2 (vl-string-position 59 str nil T))))
        )
        (setq l_str (vl-string->list str))
        (foreach el l_str
          (if (not (member el '(46 48 49 50 51 52 53 54 55 56 57)))
            (setq l_str (vl-remove el l_str))
          )
        )
        (setq
          str (vl-list->string l_str)
          ang (cdr (assoc 50 dxf_txt))
          p10
          (if (eq (cdr (assoc 0 dxf_txt)) "MTEXT")
            (cdr (assoc 10 dxf_txt))
            (polar (cdr (assoc 10 dxf_txt)) ang 1.92199)
          )
          z (atof str)
          pt_lst
          (list
            p10
            (polar
              p10
              (- ang (* 0.5 pi))
              (+ 0.45
                (if (eq (cdr (assoc 0 dxf_txt)) "MTEXT")
                  (cdr (assoc 43 dxf_txt))
                  (cdr (assoc 40 dxf_txt))
                )
              )
            )
          )
        )
        (command "_.zoom" "_ce" (cadr pt_lst) 10)
        (setq
          ss_pl
          (ssget "_F"
            pt_lst
            '((0 . "LWPOLYLINE") (8 . "GLine"))
          )
        )
        (cond
          ((and ss_pl (eq (sslength ss_pl) 1))
            (setq
              ent (ssname ss_pl 0)
              dxf_lw (entget ent)
              l_vtx (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_lw))
            )
            (if (equal (angle (car l_vtx) (cadr l_vtx)) ang 1E-03)
              (setq pt_ins (caddr l_vtx))
              (setq pt_ins (car l_vtx))
            )
            (cond
              ((and z pt_ins)
                (entmod (subst (cons 8 "GLine2") (assoc 8 dxf_lw) dxf_lw))
                (entmod (subst (cons 8 "GText2") (assoc 8 dxf_txt) dxf_txt))
                (entmake
                  (list
                    '(0 . "POINT")
                    '(100 . "AcDbEntity")
                    '(67 . 0)
                    '(410 . "Model")
                    '(8 . "GPoint2")
                    '(100 . "AcDbPoint")
                    (cons 10 (list (car pt_ins) (cadr pt_ins) z))
                    '(210 0.0 0.0 1.0)
                    '(50 . 0.0)
                  )
                )
                (setq z nil pt_ins nil sspl nil)
              )
            )
          )
          (T (setq z nil pt_ins nil sspl nil))
        )
      )
      (acet-ui-progress-done)
    )
    (command "_.zoom" "_extent")
  )
  (setvar "CMDECHO" 1)
  (prin1)
)

June 5

It shouldn't take 20 minutes something not right in the algorithm or is it the dwg ? I do something to hundreds of common objects 4 tasks and takes 2 minutes. It searches no zooming just does it. Yes started coding at 36 minutes but now 2 minutes.

I will try to find time for get text, do a bounding box offset it, then use the new offset box does it touch a Pline, if so compare the end points to the insertion point of text, swap end points if required and add a point. Yes if it touches a line a problem but run Join Multi 1st to get around that.

"Polylines with different origins (when they are not simple lines)" Need a global fix. Need to find one to see what is going on.

This is what I got looking at dwg. Would use select window so no stray text.

: (sslength (ssget "X" '((0 . "LINE")(cons 410 (getvar 'ctab)))))
0
: (sslength (ssget "X" '((0 . "MTEXT")(cons 410 (getvar 'ctab)))))
3
: (sslength (ssget "X" '((0 . "TEXT")(cons 410 (getvar 'ctab)))))
318
: (sslength (ssget "X" '((0 . "LWPOLYLINE")(cons 410 (getvar 'ctab)))))
317

Have to go somewhere soon, maybe tonight.

June 5

Mr. BIGAL and Mr. Tsuky you very much for your generous assistance.

I am grateful to all of you for sparing your valuable time,

and if there is a way to compensate for your efforts, I am always ready.

Mr Tsuky I try the last code but did not happen.

June 5

@macros55

For me this works well; I attach the result after processing.
How did I get this:
First of all, I used the StripMtext lisp (v5-0.c), you will find it on the internet, because the formatting of your MTexts is abominable. For example: to have 387.70 we find the following definition:

Quote

"\\A1;38{\\fArial|b0|i0|c238|p34;7}.{\\fArial|b0|i0|c0|p34;7\\fArial|b0|i0|c238|p34;0}"

Then I used my code, having modified line 103.for a better result.

(if (equal (angle (car l_vtx) (cadr l_vtx)) ang 1E-03)

to

(if (equal (rem (angle (car l_vtx) (cadr l_vtx)) pi) (rem ang pi) 2E-02)

NB: I use the functions (acet-ui-progress-...) to display a progress bar.
If this function is blocking execution for you, you can comment on lines 48, 50 and 131.
This will have no impact on the running of the program.

@BIGAL
There are still 11532 Text, MText to process. If I could have avoided zooming to get good results with (ssget [selection point]), I would have done so.
If you have a quick solution to avoid zooming, I would gladly see your working code.

RESULT Point to Text-Polyline rev3.dwg

June 5

Mr. @Tsuky Good day,

I have changed
(if (equal (angle (car l_vtx) (cadr l_vtx)) ang 1E-03)
to
(if (equal (rem (angle (car l_vtx) (cadr l_vtx)) pi) (rem ang pi) 2E-02)

aslo I used the StripMtext lisp (v5-0.c) before test

result
Command line: ; error: no function definition: ACET-UI-PROGRESS-INIT,

Could you please share which you used last lsp?

Edited June 5 by macros55

June 5

2 hours ago, Tsuky said:

@macros55

NB: I use the functions (acet-ui-progress-...) to display a progress bar.

If this function is blocking execution for you, you can comment on lines 48, 50 and 131.
This will have no impact on the running of the program.

Commenting out a code consists of placing a semicolon ";" at the start of the line

You don't have ExpressTools installed? They are the ones who offer this function.

Edited June 5 by Tsuky

June 5

Mr @Tsuky

I have installed the Express Tools, but I didn't got your point.

Could you please share me by video link?

June 5

This is not important, it just displays a progress bar that shows the processing progress.
You can do without it...
However, if you want to test, copy and paste the following directly into the command line by validating with enter.

((lambda ( / size i)
	(setq
		size 100000
		i 0
	)
	(acet-ui-progress-init "Working:" size)
	(repeat size
		(acet-ui-progress-safe (setq i (1+ i)))
	)
	(acet-ui-progress-done)
	(prin1)
))

You will have this:

I reattach the lisp without this progress bar. Simply wait 10 to 20 minutes depending on the power of your PC

add_pt_with_text&poly.lsp

June 5

Mr @Tsuky

Some points have been added in the opposite direction. What could be the reason for this?

June 5

What code are you using?
Because in the last delivered "add_pt_with_text&poly.lsp" this problem no longer exists! See my message https://www.cadtutor.net/forum/topic/86167-add-a-new-point-to-the-end-of-the-polyline-near-mtexttext/?do=findComment&comment=642684

Add a new Point to the end of the Polyline near MText/Text

Recommended Posts

macros55

Link to comment

Share on other sites

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

BIGAL

Tsuky

BIGAL

Posted Images

BIGAL

Link to comment

Share on other sites

macros55

Link to comment

Share on other sites

macros55

Link to comment

Share on other sites

Tsuky

Link to comment

Share on other sites

macros55

Link to comment

Share on other sites

Tsuky

Link to comment

Share on other sites

Tsuky

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

macros55

Link to comment

Share on other sites

Tsuky

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

macros55

Link to comment

Share on other sites

Tsuky

Link to comment

Share on other sites

macros55

Link to comment

Share on other sites

Tsuky

Link to comment

Share on other sites

macros55

Link to comment

Share on other sites

Tsuky

Link to comment

Share on other sites

macros55

Link to comment

Share on other sites

Tsuky

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity