Topic: re-visit: Change cursor in a piece of code ...

[Hangman]

I figure this is revisiting this topic as this link is another similar question
http://www.theswamp.org/index.php?topic=9216.0
But I am hoping someone may have discovered something in the last four years.

So I have this piece of code TWilley helped put together which I use almost constantly in converting DGN drawings to DWG's.  Thank you again Tim.
It copies the value of an existing text to a new string, or a better explanation could also be copying the value of an existing text to an attribute value.  My titleblocks have plenty of attribute values needing to be filled and this works superbly.

Code: [Select]

(and
  (setq Sel (nentsel "\n Select text/attribute to copy value from: "))
  (setq FromObj (vlax-ename->vla-object (car Sel)))
  (setq Sel (nentsel "\n Select text/attribute to copy value to: "))
  (setq ToObj (vlax-ename->vla-object (car Sel)))
  (mapcar
   '(lambda (x)
    (vlax-put ToObj x (vlax-get FromObj x)))
   '("TextString")
  )
 )
I would like to add to it though by adding something to the cursor.  Much like when you are running the 'matchprop' command.  You select the object to be copied, and then the cursor changes slightly so you know when you have the object selected and you are ready to match the properties to another object.

Anyone have any ideas?

Thanks.

[Lee Mac]

Kinda like I do here?  :kewl:

[Lee Mac]

Example, changing the cursor into an X 

Code: [Select]

(defun c:test ( / gr )

  (while (= 5 (car (setq gr (grread 't 13 1))))
    (redraw)
    (LM:grX (trans (cadr gr) 1 0) 7 3)
  )
  (redraw) (princ)
)                                                 

;;-----------------------=={ grX }==--------------------------;;
;;                                                            ;;
;;  Displays an 'X' in at the point specified, in the colour  ;;
;;  specified                                                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  p - point at which to display 'X' (in WCS)                ;;
;;  s - size of point (in screen pixels)                      ;;
;;  c - colour of point (ACI Colour)                          ;;
;;------------------------------------------------------------;;
;;  Returns:  The WCS point supplied                          ;;
;;------------------------------------------------------------;;

(defun LM:grX ( p s c / -s r q )
  ;; © Lee Mac 2010
  (setq -s (- s) r (/ (getvar 'VIEWSIZE) (cadr (getvar 'SCREENSIZE))) q (trans p 0 3))

  (grvecs
    (list c
      (list -s      -s) (list s       s) (list -s (1+ -s)) (list (1- s)  s)
      (list (1+ -s) -s) (list s  (1- s)) (list -s       s) (list s      -s)
      (list -s  (1- s)) (list (1- s) -s) (list (1+ -s)  s) (list s (1+ -s))
    )
    (list
      (list r  0. 0. (car  q))
      (list 0. r  0. (cadr q))
      (list 0. 0. r  0.)
      (list 0. 0. 0. 1.)
    )
  )
  p
)

Only practical for selection though, as you'll likely be aware, GrRead disables OSnap/Ortho/Tracking and pretty much everything else...

[Hangman]

Example, changing the cursor into an X 

 < .. >

Only practical for selection though, as you'll likely be aware, GrRead disables OSnap/Ortho/Tracking and pretty much everything else...

Oh, yes!  As this piece of code I am using is only selecting text.  So we could change the cursor from the typical box to a circle when using the "copy value to: ".  And the color from the looks of it. 

[Lee Mac]

Another example, more akin to the MatchProps setup 

Code: [Select]

(defun c:test ( / gr e )

  (while (= 5 (car (setq gr (grread 't 13 2))))
    (redraw)
    (LM:gr+ (trans (polar (cadr gr) (/ pi -4.) (/ (getvar 'VIEWSIZE) 20.)) 1 0) 7 2)
  )
  (redraw)

  (if (and (= 3 (car gr)) (setq e (car (nentselp (cadr gr)))))
    (sssetfirst nil (ssadd e))
  )
  (princ)
)                                                 

(defun LM:gr+ ( p s c )
  ;; © Lee Mac 2010
  (setq -s (- s) r (/ (getvar 'VIEWSIZE) (cadr (getvar 'SCREENSIZE))) q (trans p 0 3))

  (grvecs
    (list c
      (list -s  0) (list s  0) (list  0 -s) (list  0 s)
      (list -s  1) (list s  1) (list  1 -s) (list  1 s)
      (list -s -1) (list s -1) (list -1 -s) (list -1 s)
    )
    (list
      (list r  0. 0. (car  q))
      (list 0. r  0. (cadr q))
      (list 0. 0. r  0.)
      (list 0. 0. 0. 1.)
    )
  )
  p
)


I'm having fun 

[Lee Mac]

Hacked together to apply to your code:

Code: [Select]

(defun c:test ( / e1 e2 gr ) (vl-load-com)
  (if
    (and
      (setq e1 (car (nentsel "\nSelect Text/Attribute to Copy from: ")))
      (member (cdr (assoc 0 (entget e1))) '("TEXT" "ATTRIB"))
      (progn
        (princ "\nSelect Text/Attribute to Copy Value to: ")
        (while (= 5 (car (setq gr (grread 't 13 2))))
          (redraw)
          (LM:gr+ (trans (polar (cadr gr) (/ pi -4.) (/ (getvar 'VIEWSIZE) 20.)) 1 0) 7 2)
        )
        (redraw)
        (and (= 3 (car gr)) (setq e2 (car (nentselp (cadr gr)))) (member (cdr (assoc 0 (entget e2))) '("TEXT" "ATTRIB"))
        )
      )
    )
    (vlax-put-property (vlax-ename->vla-object e2) 'TextString
      (vlax-get-property (vlax-ename->vla-object e1) 'TextString)
    )
  )
  (princ)
)                                                 

(defun LM:gr+ ( p s c )
  ;; © Lee Mac 2010
  (setq -s (- s) r (/ (getvar 'VIEWSIZE) (cadr (getvar 'SCREENSIZE))) q (trans p 0 3))

  (grvecs
    (list c
      (list -s  0) (list s  0) (list  0 -s) (list  0 s)
      (list -s  1) (list s  1) (list  1 -s) (list  1 s)
      (list -s -1) (list s -1) (list -1 -s) (list -1 s)
    )
    (list
      (list r  0. 0. (car  q))
      (list 0. r  0. (cadr q))
      (list 0. 0. r  0.)
      (list 0. 0. 0. 1.)
    )
  )
  p
)
For object highlighting a little more code is needed..

[Hangman]

< .. >
I'm having fun 

I guess so!   

You're posting code faster than I can read the replies.

Very nice Lee, Thank you.

[Lee Mac]

A more refined example:

Code: [Select]

(defun c:test ( / e1 e2 ) (vl-load-com)
  (if
    (and
      (setq e1
        (LM:sel "\nSelect Text/Attribute to Copy from: " 1
         '(lambda ( x ) (wcmatch (cdr (assoc 0 (entget x))) "TEXT,ATTRIB"))
        )
      )
      (setq e2
        (LM:sel "\nSelect Text/Attribute to Copy Value to: " 3
         '(lambda ( x ) (wcmatch (cdr (assoc 0 (entget x))) "TEXT,ATTRIB"))
        )
      )
    )
    (vlax-put-property (vlax-ename->vla-object e2) 'TextString
      (vlax-get-property (vlax-ename->vla-object e1) 'TextString)
    )
  )
  (redraw) (princ)
)       

(defun LM:sel ( msg col pred / gr code data h1 h2 e )
  ;; © Lee Mac 2011
  (princ msg) (setq pred (eval pred))
 
  (while
    (progn
      (setq gr (grread 't 13 2) code (car gr) data (cadr gr))

      (cond
        (
          (= 5 code)

          (redraw)
          (LM:gr+ (trans (polar data (/ pi -4.) (/ (getvar 'VIEWSIZE) 20.)) 1 0) 7 col)

          (if (setq h1 (car (nentselp data)))
            (redraw (setq h2 h1) 3)
            (if h2 (setq h2 (redraw h2 4)))
          )         
          T
        )
        (
          (= 3 code)

          (if (setq e (car (nentselp data)))

            (if (not (pred e))
              (progn
                (setq e nil)
                (princ (strcat "\n** Invalid Object Selected **" msg))               
              )
            )
            (princ (strcat "\n** Missed, Try Again **" msg))
          )
        )
      )
    )
  )
  (if h2 (setq h2 (redraw h2 4)))
  e
)

(defun LM:gr+ ( p s c )
  ;; © Lee Mac 2011
  (setq -s (- s) r (/ (getvar 'VIEWSIZE) (cadr (getvar 'SCREENSIZE))) q (trans p 0 3))

  (grvecs
    (list c
      (list -s  0) (list s  0) (list  0 -s) (list  0 s)
      (list -s  1) (list s  1) (list  1 -s) (list  1 s)
      (list -s -1) (list s -1) (list -1 -s) (list -1 s)
    )
    (list
      (list r  0. 0. (car  q))
      (list 0. r  0. (cadr q))
      (list 0. 0. r  0.)
      (list 0. 0. 0. 1.)
    )
  )
  p
)


^^ Happier with that one 

[Lee Mac]

You're posting code faster than I can read the replies.

I get a bit carried away sometimes ... 

[Hangman]

And to include MText, MLeaders, ?blocks?, ... (I'm not sure about blocks, I have not yet needed to pull text from a block, and there is some text in the titleblock that is not attributable, could get ugly), simply adjust the line(s)

Code: [Select]

'(lambda ( x ) (wcmatch (cdr (assoc 0 (entget x))) "TEXT,[color=red]MTEXT,MLEADER,[/color]ATTRIB"))to include them.


Question:  is this section:

Code: [Select]

(grvecs
    (list c
      (list -s  0) (list s  0) (list  0 -s) (list  0 s)
      (list -s  1) (list s  1) (list  1 -s) (list  1 s)
      (list -s -1) (list s -1) (list -1 -s) (list -1 s)
    )
    (list
      (list r  0. 0. (car  q))
      (list 0. r  0. (cadr q))
      (list 0. 0. r  0.)
      (list 0. 0. 0. 1.)
    )
  )

for where the + sign would be displayed?  And if so, can they carry a smaller number?
I was just wondering if the marker could be brought in closer to the selection box and put in the upper right corner, so it's similar to ACAD's cursors when used (much like the matchprop cursor).
Something I can play with in my spare time.

But hey, while your ...

... a bit carried away sometimes ...

For object highlighting a little more code is needed...

 

[Lee Mac]

And to include MText, MLeaders, ?blocks?, ... (I'm not sure about blocks, I have not yet needed to pull text from a block, and there is some text in the titleblock that is not attributable, could get ugly), simply adjust the line(s)

Code: [Select]

'(lambda ( x ) (wcmatch (cdr (assoc 0 (entget x))) "TEXT,ATTRIB"))to include them.

Not quite - you have formatting codes and other things to consider...

My recent attempts:

http://www.theswamp.org/index.php?topic=36265.0

(But no fancy cursor I'm afraid  )

Question:  is this section:
< ...  snip ... >

for where the + sign would be displayed?  And if so, can they carry a smaller number?
I was just wondering if the marker could be brought in closer to the selection box and put in the upper right corner, so it's similar to ACAD's cursors when used (much like the matchprop cursor).

You needn't touch the sub, the size is determined by a size argument and position is also controlled in the LM:Sel sub:

Code: [Select]

(LM:gr+ (trans (polar data [color=green](/ pi -4.)[/color] [color=red](/ (getvar 'VIEWSIZE) 20.)[/color]) 1 0) [color=blue]7[/color] col)

Distance in Red, Angle from cursor in green, Size (in pixels) of cross in blue.

But hey, while your ...

... a bit carried away sometimes ...

For object highlighting a little more code is needed...

   

That should already be incorporated into my latest code 

[Hangman]

Lee, ...

I know you've been told this before, but I just have to say it again,

You're Awesome !!!

[Lee Mac]

That's very kind of you Mr Hangman