Jump to content

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


macros55

Recommended Posts

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?

Point to Text-Polyline.dwg

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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)
)

 

Link to comment
Share on other sites

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)
)

 

Link to comment
Share on other sites

Posted (edited)

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.

 

image.thumb.png.49b39ee07e24c82630bdf544f2778de1.png

 

 

Point to Text-Polyline rev2.dwg

Edited by macros55
Link to comment
Share on other sites

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?)

Link to comment
Share on other sites

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)
)

 

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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)
)

 

  • Like 1
Link to comment
Share on other sites

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.

  • Like 1
Link to comment
Share on other sites

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.

Link to comment
Share on other sites

@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

Link to comment
Share on other sites

Posted (edited)

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 by macros55
Link to comment
Share on other sites

Posted (edited)
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 by Tsuky
Link to comment
Share on other sites

Mr @Tsuky 

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

Could you please share me by video link?

 

image.thumb.png.bf00024319cba26107ded8629305f506.png

Link to comment
Share on other sites

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:

Capturedcran2024-06-05212102.png.482c7cdd801b5ba1f0fbc4580f873daf.png

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

Link to comment
Share on other sites

Mr @Tsuky

 

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

 

image.thumb.png.d7f14a1a7b368537b6e8f1256fc45f4c.png

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...