macros55 Posted May 31 Share Posted 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? Point to Text-Polyline.dwg Quote Link to comment Share on other sites More sharing options...
BIGAL Posted May 31 Share Posted 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. Quote Link to comment Share on other sites More sharing options...
macros55 Posted June 1 Author Share Posted 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) ) Quote Link to comment Share on other sites More sharing options...
macros55 Posted June 3 Author Share Posted June 3 Mr. @Tsuky Could you please help this? Quote Link to comment Share on other sites More sharing options...
Tsuky Posted June 3 Share Posted 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) ) Quote Link to comment Share on other sites More sharing options...
macros55 Posted June 3 Author Share Posted June 3 (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. Point to Text-Polyline rev2.dwg Edited June 3 by macros55 Quote Link to comment Share on other sites More sharing options...
Tsuky Posted June 3 Share Posted 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?) Quote Link to comment Share on other sites More sharing options...
Tsuky Posted June 3 Share Posted 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) ) Quote Link to comment Share on other sites More sharing options...
BIGAL Posted June 4 Share Posted 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. Quote Link to comment Share on other sites More sharing options...
macros55 Posted June 4 Author Share Posted 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 Quote Link to comment Share on other sites More sharing options...
Tsuky Posted June 4 Share Posted 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) ) 1 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted June 5 Share Posted 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. 1 Quote Link to comment Share on other sites More sharing options...
macros55 Posted June 5 Author Share Posted 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. Quote Link to comment Share on other sites More sharing options...
Tsuky Posted June 5 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
macros55 Posted June 5 Author Share Posted June 5 (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 June 5 by macros55 Quote Link to comment Share on other sites More sharing options...
Tsuky Posted June 5 Share Posted June 5 (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 June 5 by Tsuky Quote Link to comment Share on other sites More sharing options...
macros55 Posted June 5 Author Share Posted 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? Quote Link to comment Share on other sites More sharing options...
Tsuky Posted June 5 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
macros55 Posted June 5 Author Share Posted June 5 Mr @Tsuky Some points have been added in the opposite direction. What could be the reason for this? Quote Link to comment Share on other sites More sharing options...
Tsuky Posted June 5 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.