write select text lsp

write select text lsp

Anonymous
Not applicable
1,188 Views
5 Replies
Message 1 of 6

write select text lsp

Anonymous
Not applicable

hello expert guys. always thank you

I need a lsp. I would like to automatically write the selected text to the drawing.

I attached dwg file. some help. happy x-mas.

 

0 Likes
Accepted solutions (1)
1,189 Views
5 Replies
Replies (5)
Message 2 of 6

Moshe-A
Mentor
Mentor

@Anonymous hi,

 

how about that?

 

(defun c:MatchText (/ select_text ; local function
		        ent0 ent1 val0 val1 ss elist p0 hgt ang)

 (defun select_text (msg / ent)
  (if (and
	 (setq ent (car (entsel msg)))
         (eq (cdr (assoc '0 (entget ent))) "TEXT")
      )
   (progn
    (redraw ent 3) 
     ent
   )
  )
 ); select_text


 (setvar "cmdecho" 0)
 (command "._undo" "_begin")
 (setvar "blipmode" 1)
  
 (if (and
       (setq ent0 (select_text "\nSource text: "))
       (setq val0 (cdr (assoc '1 (entget ent0))))
       (setq ent1 (select_text "\nMatch text: "))
       (setq val1 (cdr (assoc '1 (entget ent1))))
       (setq ss (ssget (list '(0 . "text") (cons '1 val0))))
     )
  (progn
   (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (setq elist (entget ename))
    (setq p0 (cdr (assoc '10 elist)))
    (setq hgt (cdr (assoc '40 elist)))
    (setq ang (cdr (assoc '50 elist)))
    
    (command "._text" p0 (* hgt 0.5) (angtos ang 0 4) val1)
    (command "._chprop" "si" "last" "color" 6 "") 
   ); foreach

   (redraw ent1 4)
   (redraw ent0 4)
  ); progn
 ); if

 (command "._undo" "_end")
 (setvar "cmdecho" 1)
  
 (princ)
)
Message 3 of 6

Anonymous
Not applicable

I got this code from one of my friend.

Please try this.

FOR MERGING OF TEXTS
(defun c:Mrg( / Text1st Text2nd )
 (setvar "CMDECHO" 0)
 (prompt "\nThis will merge two texts in one ")
 (while (and (setq Text1st (entget (car (entsel "\nSelect first text: "))))
             (setq Text2nd (entget (car (entsel "\nSelect second text: ")))))

  (entmod (subst (cons '1 (strcat (cdr (assoc 1 Text1st))
                  " - "
                  (cdr (assoc 1 Text2nd))))
         (assoc 1 Text1st)
         Text1st))
  (entdel (cdr (assoc -1 Text2nd)))
 )

 (princ)
)
Message 4 of 6

dbhunia
Advisor
Advisor

Try this......

 

(defun C:COT (/ 1st 2nd ss);;Put temp variables
(setvar 'cmdecho 0)
(setq osm (getvar 'osmode))
(setvar 'osmode 0)
(setq 1st (cdr (assoc 1 (entget (car (entsel "\nSelect 1st Text..."))))))
(setq 2nd (cdr (assoc 1 (setq 2obj (entget (car (entsel "\nSelect 2nd Text...")))))))
(setq ss (ssget "_A" '((0 . "TEXT"))))
(repeat (setq N (sslength ss))
	(setq Data (ssname ss (setq N (- N 1))))
	(setq obj (vlax-ename->vla-object Data))
	(if (= 1st (vla-get-Textstring obj))
	    (progn
		(command "copy" Data "" "0,0,0" "@")
		(setq IT (entlast))
		(setq Tobj (vlax-ename->vla-object IT))
		(setq TobjT (vla-get-Textstring Tobj))
		(setq FT (strcat TobjT "-" 2nd))
		(vla-put-Textstring Tobj FT)
		(vlax-put-property Tobj 'Height (/ (vlax-get-property Tobj 'Height) 2))
		(vlax-put-property Tobj 'color 6)
	    )
	)
)
(setvar 'osmode osm)
(setvar 'cmdecho 1)
(princ)
)

Debashis Bhunia
Co-Founder of Geometrifying Trigonometry(C)
________________________________________________
Walking is the First step of Running, Technique comes Next....
Message 5 of 6

dbhunia
Advisor
Advisor
Accepted solution

Try this one......(with little modification of previous one)

 

(defun C:COT (/ 1st 2nd FT ss N Data obj Tobj)
(setvar 'cmdecho 0)
(setq osm (getvar 'osmode))
(setq 1st (cdr (assoc 1 (entget (car (entsel "\nSelect 1st Text..."))))))
(setq 2nd (cdr (assoc 1 (entget (car (entsel "\nSelect 2nd Text..."))))))
(setq FT (strcat 1st "-" 2nd))
(setvar 'osmode 0)
(setq ss (ssget "_A" '((0 . "TEXT"))))
(repeat (setq N (sslength ss))
	(setq Data (ssname ss (setq N (- N 1))))
	(setq obj (vlax-ename->vla-object Data))
	(if (= 1st (vla-get-Textstring obj))
	    (progn
		(command "copy" Data "" "0,0,0" "@")
		(setq Tobj (vlax-ename->vla-object (entlast)))
		(vla-put-Textstring Tobj FT)
		(vlax-put-property Tobj 'Height (/ (vlax-get-property Tobj 'Height) 2))
		(vlax-put Tobj 'TextAlignmentPoint (vlax-get Tobj 'InsertionPoint))
		(vlax-put-property Tobj 'color 6)
	    )
	)
)
(setvar 'osmode osm)
(setvar 'cmdecho 1)
(princ)
)

Debashis Bhunia
Co-Founder of Geometrifying Trigonometry(C)
________________________________________________
Walking is the First step of Running, Technique comes Next....
0 Likes
Message 6 of 6

Anonymous
Not applicable

thank you... happy xmas

0 Likes