Jump to content
itacad

Lisp for copy text...variations on the theme

Recommended Posts

itacad

Hello, in my work (unfortunately) I spend a lot (too much) of time copying texts between blocks...Fortunately, however, I found some lisps that speed up this operation!

But I could not find alternatives that I would need in two particular situations:

 

Situation 1 (very important for me): cumulative copy in one destination.

For example A,B,C, D1, 23, Z = ABCD123Z in the destination

 

Situation 2 (not very important but reccurent); single paste and return to copy.

The lisp I use allows, once copied the text, to paste it many times, but usually I have to paste it once, and once done it would be much more practical have already ready the copy phase...

 

have you ever seen something similar?

 

Thank you in advance

Share this post


Link to post
Share on other sites
itacad

Hi, I add to the topic a further feature that I could not find: starting from the fact that in the windows clipboard I put text I want to transcribe in autocad (in a single line text, multiline text or attribute), have you ever create a lisp to paste directly from the clipboard to the autocad's text object by click over?

Greetings

Share this post


Link to post
Share on other sites
BIGAL

Double click the text Ctrl+a Ctrl+v

Share this post


Link to post
Share on other sites
itacad

:) he he...think that I use a gaming mouse and "ctrl+a" and "ctrl+v" are stored on special buttons so the operation is already very fast (I do not even have to take my hands off the mouse)...but not comparable with the speed obtained with a specific lisp...

I would not look like a lazy man, but I am very happy when I can shorten a single operation that I do repeatedly!

Hi!

Share this post


Link to post
Share on other sites
rlx

ok , just some lunch copy & paste :

 

 

(defun c:tst ( / p1 p2 ents)
 (while (and (setq p1 (getpoint "\n1st corner : ")) (setq p2 (getcorner p1 "\n2nd corner : "))
      (setq ents (sfs p1 p2))(setq ents (el_sort ents p1 p2)))
   (alert (apply 'strcat (vl-remove-if 'void (mapcar '(lambda (x / s)(cdr (assoc 1 (entget x)))) ents)))))
 (princ)
)
(defun inside_amy (ent p1 p2 / ip )
 (if (and (>= (car (setq ip (getip ent)))  (min (car p1)(car p2)))   (<= (car ip)  (max (car p1)(car p2)))
   (>= (cadr ip) (min (cadr p1)(cadr p2))) (<= (cadr ip) (max (cadr p1)(cadr p2)))) t nil))
; get insertionpoint
(defun getip (e) (list (cadr (assoc 10 (entget e)))(caddr (assoc 10 (entget e)))))
; black hole with hawking radiation
(defun void (x) (if (member x (list "" " " "  " "   " "    " "     " nil '())) t nil))
; scan for string
(defun sfs ( %p1 %p2 / i ss el e et)
(if (setq i 0 ss (ssget "c" %p1 %p2))
  (while (setq e (ssname ss i))
   (setq et (cdr (assoc 0 (entget e))) i (1+ i))
   (cond ((member et '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))(setq el (cons e el)))
  ((= et "INSERT") (mapcar '(lambda (x) (if (inside_amy x %p1 %p2)(setq el (cons x el))))(get-bents e)))))) el)
; get block entities
(defun get-bents ( b / obj e lst)
 ;attrib
 (setq obj (vlax-ename->vla-object b))
 (if (eq :vlax-true (vla-get-HasAttributes obj)) (setq lst (mapcar 'vlax-vla-object->ename (vlax-invoke obj 'GetAttributes))))
 ;text , disable if only attributes are needed
 (setq e (tblobjname "block" (vla-Get-EffectiveName obj)))
 (while (setq e (entnext e)) (if (member (cdr (assoc 0 (entget e))) (list "TEXT" "ATTDEF")) (setq lst (cons e lst)))) lst)
; mode = nil : sort list with entities from y-max to y-min , mode = t : sort from y-min to y-max
(defun sort_ents_y ( %ents mode)
 (vl-sort %ents '(lambda (e1 e2) ((if mode > <) (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2)))))))
; mode = nil : sort list with entities from x-max to x-min , mode = t : sort from x-min to x-max
(defun sort_ents_x ( %ents mode)
 (vl-sort %ents '(lambda (e1 e2) ((if mode > <) (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2)))))))
(defun el_sort ( %el %p1 %p2 / dX dY)
 (setq dX (- (car %p2) (car %p1)) dY (- (cadr %p2) (cadr %p1)))
 (if (> (abs dX) (abs dY))(if (> dX 0)(sort_ents_x %el nil)(sort_ents_x %el t)) (if (> dY 0)(sort_ents_y %el nil)(sort_ents_y %el t)))
)

 

 

ps direction of selection matters...

 

 

gr. Rlx

Share this post


Link to post
Share on other sites
rlx
Posted (edited)
Thank you rlx, try your lisp but I don't understand how it works...

In the meantime I found this topic in your huge forum

http://www.cadtutor.net/forum/showthread.php?87782-Are-there-a-way-copy-and-paste-via-clipboard-by-lisp

 

"Demopaste" does exactly what I need, but it works only with single line text...what a pity

 

Routine was just a demo to combine some texts. In place for the alert function you would place an entsel to select entity to place the combined strings in. Most of the functions you seek can be done with my VT routine , like row(s) to row(s) etc.

 

attachment.php?attachmentid=63508&cid=1&stc=1

 

 

Gr. Rlx

itacad.png

Edited by rlx

Share this post


Link to post
Share on other sites
BIGAL

Sounds like a 1 size fits all, using a ssget you could pick 1 or multiple objects, repeating as required. For the 1 at a time just look at it is it text or mtext and make new string, for a multiple again look at it but take into account say Y co-ord and sort before adding together.

 

Very much like the RLX code a number of defuns needed the multi would be done by the fact that the ssget has only 1 item so its a single go to next pick object.

 

Not a 5 minute job.

Share this post


Link to post
Share on other sites
BIGAL

If you pay peanuts then you get monkeys coding.

 

(defun c:addtxt ( / obj ans)
(while (setq obj (vlax-ename->vla-object (car (entsel "\nPick text object"))))
(setq ans (strcat ans (vla-get-textstring obj)))
)

(princ ans)

)

Share this post


Link to post
Share on other sites
rlx
If you pay peanuts then you get monkeys coding.

 

 

hahaha :P :beer:

 

 

The way I see it , and this has been described in many different ways, if you want to help somebody with their homework , you don't help them by doing their homework for them.

 

 

gr. Rlx

Share this post


Link to post
Share on other sites
rlx
Posted (edited)

ok then, because its weekend some more lunch fun :

 

 

routine allows user to continuously copy string from one object to another. Program uses grread so during execution no transparent commands can be used. To make up for this , you can use Z key for zoom , E key for zoom extents , + and - key for zooming in or out. Space , enter of Esc cancels the loop.

 

; rlx 19-3-2018 : text-copy-in-a-loopy , copy text string from one object to another
(defun c:t2 ( / e1 e2 osm)
 (setq osm (getvar "snapmode"))(setvar "snapmode" 0)
 (princ "\nEsc, enter, Rmouse to cancel, zoom with E(extend), Z(oom) or + / -\nSelect object with string :")
 (while (setq e1 (RlxSel "\nSource text : "))
   (if (setq e2 (RlxSel "\nTarget text : "))(progn (update_txt e1 e2 )(redraw e1 4)(redraw e2 4))))
 (setvar "snapmode" osm)
 (princ)
)
(defun update_txt (%source %target)
 (if (vlax-property-available-p (vlax-ename->vla-object %target) 'textstring t)
   (vla-put-textstring (vlax-ename->vla-object %target) (vla-get-textstring (vlax-ename->vla-object %source)))))

(defun has_string (e) (vlax-property-available-p (vlax-ename->vla-object e) 'textstring))

(defun RlxSel ( $msg / done-selecting inp i p2 result e ent)
 (princ $msg)
 (setq done-selecting nil)
 (while (not done-selecting)
   (setq inp (vl-catch-all-apply 'grread (list nil 4 2)))
   (if (vl-catch-all-error-p inp)
     (setq done-selecting t result nil)
     (cond
; if point selected
((= (car inp) 3)
 ; if point has object under it
 (if (setq ent (nentselp (cadr inp))) (setq e (car ent)))
 (cond
   ; if we have object and object is the right type we have a winner
   ((and e (has_string e)) (redraw e 3)(setq done-selecting t result e))
   ; maybe its the parent - this happens when type is dimension and you select dimensions text
   ((and (caddr ent) (setq ent (last (last ent)))(has_string ent))
    (redraw ent 3)(setq done-selecting t result ent))
   ; sorry object is not the right stuf
   ((and e (not (has_string e))) (princ "\rThis entity contains no text string"))
   ; missed , no object found under selected point ... try crossing selection
   (t (if (and (setq i 0 p2 (getcorner (cadr inp) "\rOther corner : ")) (setq ss (ssget "c" (cadr inp) p2)))
 (while (and (not done-selecting) (setq e (ssname ss i)))
   (if (has_string e)(progn (redraw e 3) (setq result e done-selecting t))) (setq i (1+ i))))
   );end t
 ); end cond
       ); end (= (car inp) 3)

; user pressed E of e
((member inp '((2 69)(2 101))) (command "zoom" "e"))
; user clicked R-mouse button, pressed enter or space (done selecting)
((or (equal (car inp) 25)(member inp '((2 13)(2 32))))
 (setq done-selecting t result nil))
; user pressed +
((equal inp '(2 43)) (command "zoom" "2x"))
; user pressed -
((equal inp '(2 45)) (command "zoom" ".5x"))
; user pressed z or Z
((member inp '((2 122)(2 90))) (command "'zoom" ""))
     )
   )
 )
 result
)

gr.Rlx

Edited by rlx

Share this post


Link to post
Share on other sites
BIGAL

rlx the reason I thought use ssget as you can pick 1 or pick multiple by not putting any filter about selecting, just have the filter *text,dimension, then if you had random rows of *text you could accept join in say there y value order. I just picked a column of individual text {window} + 1 mtext {pick} so would be in draw order by doing as single picks {window} sort on Y + single pick + {window} sort on Y and so on

 

(setq ss (ssget (list (cons 0 "*text"))))

Share this post


Link to post
Share on other sites
rlx
rlx the reason I thought use ssget as you can pick 1 or pick multiple by not putting any filter about selecting, just have the filter *text,dimension, then if you had random rows of *text you could accept join in say there y value order. I just picked a column of individual text {window} + 1 mtext {pick} so would be in draw order by doing as single picks {window} sort on Y + single pick + {window} sort on Y and so on

 

(setq ss (ssget (list (cons 0 "*text"))))

 

Just cut copy paste (and lunched) something together. Not claiming it's better. Just wanted routine that allows single pick , autoswitch to window (crossing actually) if needed , and can also find strings in nested entities etc. It workes just fine for me in a couple of routines I use daily but if you have something better , please do post because what I like most about your codes is your no-nonsense approach and I often think , how did I not see that... I usually try to make code that I can use in more applications, even if it means some parts can be shorter. But that's an old discussion , what's better , faster code of less development time by beeing able to quickly paste something together... I'm clearly fan of the latter. When programs are getting bigger , your have to pay more attention to a good structure , at least , thats my personal experience.

 

:beer:

 

gr. Rlx

Share this post


Link to post
Share on other sites
BIGAL

Give the task to 4 people and you will get 4 different answers to the final solution. I think its time to wait for itacad before any more changes.

Share this post


Link to post
Share on other sites
itacad

here I am! sorry for the delay of the reply!

I try the rlx's lisp and it works how I need!

Thank you very much!

Share this post


Link to post
Share on other sites
rlx
here I am! sorry for the delay of the reply!

I try the rlx's lisp and it works how I need!

Thank you very much!

 

nos problemos , you're welcome

 

:beer:

 

gr.Rlx

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×