TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: alanjt on October 19, 2009, 03:30:17 PM

Title: Entsel/NEntsel with hovering object layer name cursor display
Post by: alanjt on October 19, 2009, 03:30:17 PM
In the spirit of all the Grread fun, I played around with a selection that would display the object's layer name as the user hovered the cursor over said object, at the cursor (mimicking dynamic mode).

Code: [Select]
;;; Entsel/NEntsel with display of layer name of object on mouse over and optional keyword
;;; #Nested - T for nested selection, nil if not
;;; #Prompt - Prompt string to display, when not displaying object's layer name
;;; #Keywords - Comma delimited key letters or nil to ignore (ie: "A,b" to match A, a, B or b
;;; Alan J. Thompson, 10.20.09
(defun AT:EntselLayerDisplay
       (#Nested #Prompt #Keywords / *error* #Layer #Prompt #Text #Read #Temp #Final)
  (setq *error* (lambda (x) (and #Text (vl-catch-all-apply 'vla-delete (list #Text))))
        #Layer  (vlax-ename->vla-object (tblobjname "layer" "0"))
  ) ;_ setq
  (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
  (or #Prompt (setq #Prompt "Select object: "))
  (or (eq (getvar 'clayer) "0") (vla-put-freeze #Layer :vlax-false))
  (vla-put-lock #Layer :vlax-false)
  (vla-put-layeron #Layer :vlax-true)
  (setq #Text (vlax-ename->vla-object
                (entmakex (list '(0 . "MTEXT")
                                '(100 . "AcDbEntity")
                                '(100 . "AcDbMText")
                                '(8 . "0")
                                '(62 . 250)
                                '(90 . 1)
                                '(63 . 7)
                                '(45 . 1.3)
                                (cons 40 (* (getvar "viewsize") 0.013))
                                (cons 10 (trans (cadr (grread T 15 0)) 1 0))
                          ) ;_ list
                ) ;_ entmakex
              ) ;_ vlax-ename->vla-object
  ) ;_ setq
  (vl-catch-all-apply
    '(lambda ()
       (vlax-invoke
         (vla-AddObject
           (vla-GetExtensionDictionary
             (if (or (eq acmodelspace (vla-get-activespace *AcadDoc*))
                     (eq :vlax-true (vla-get-mspace *AcadDoc*))
                 ) ;_ or
               (vla-get-modelspace *AcadDoc*)
               (vla-get-paperspace *AcadDoc*)
             ) ;_ if
           ) ;_ vla-GetExtensionDictionary
           "ACAD_SORTENTS"
           "AcDbSortentsTable"
         ) ;_ vla-AddObject
         'MoveToTop
         (list #Text)
       ) ;_ vlax-invoke
     ) ;_ lambda
  ) ;_ vl-catch-all-apply
  (while (and (setq #Read (grread T 15 2))
              (/= (cadr #Read) 13)
              (/= (car #Read) 25)
              (not (vl-position (cadr #Read) '(13 158)))
              (not #Final)
         ) ;_ and
    (cond
      ((eq 5 (car #Read))
       (vla-put-insertionpoint
         #Text
         (vlax-3d-point (polar (trans (cadr #Read) 1 0) (* pi 1.75) (* (getvar "viewsize") 0.02)))
       ) ;_ vla-put-insertionpoint
       (vla-put-height #Text (* (getvar "viewsize") 0.013))
       (if (setq #Ent (nentselp (cadr #Read)))
         (if #Nested
           (vla-put-textstring #Text (cdr (assoc 8 (entget (car #Ent)))))
           (cond
             ((eq (length #Ent) 2) (vla-put-textstring #Text (cdr (assoc 8 (entget (car #Ent))))))
             ((eq (length #Ent) 4)
              (vla-put-textstring #Text (cdr (assoc 8 (entget (car (car (reverse #Ent)))))))
             )
           ) ;_ cond
         ) ;_ if
         (vla-put-textstring #Text #Prompt)
       ) ;_ if
      )
      ((eq 3 (car #Read))
       (if (setq #Temp (nentselp (cadr #Read)))
         (progn
           (or #Nested
               (and (eq 4 (length #Temp))
                    (setq #Temp (list (car (car (reverse #Temp))) (cadr #Temp)))
               ) ;_ and
           ) ;_ or
           (or (eq (vla-get-objectid (vlax-ename->vla-object (car #Temp)))
                   (vla-get-objectid #Text)
               ) ;_ eq
               (setq #Final #Temp)
           ) ;_ or
         ) ;_ progn
       ) ;_ if
      )
      ((and #Keywords (eq (car #Read) 2))
       (if (wcmatch (strcase (chr (cadr #Read))) (strcase #Keywords))
         (setq #Final (chr (cadr #Read)))
       ) ;_ if
      )
    ) ;_ cond
  ) ;_ while
  (*error* nil)
  #Final
) ;_ defun

Examples:
Code: [Select]
;;; Nested
(defun c:Test (/ #Ent)
  (while
    (setq #Ent (AT:EntselLayerDisplay T "Select object on layer to turn off or [Current]: " "C"))
     (cond
       ((vl-consp #Ent)
        (vla-put-layeron
          (vlax-ename->vla-object (tblobjname "layer" (cdr (assoc 8 (entget (car #Ent))))))
          :vlax-false
        ) ;_ vla-put-layeron
       )
       ((vl-position #Ent '("C" "c"))
        (vla-put-layeron (vlax-ename->vla-object (tblobjname "layer" (getvar "clayer"))) :vlax-false)
       )
     ) ;_ cond
  ) ;_ while
  (princ)
) ;_ defun

Code: [Select]
;;; Not Nested
(defun c:Test (/ #Ent)
  (while
    (setq #Ent (AT:EntselLayerDisplay nil "Select object on layer to turn off or [Current]: " "C"))
     (cond
       ((vl-consp #Ent)
        (vla-put-layeron
          (vlax-ename->vla-object (tblobjname "layer" (cdr (assoc 8 (entget (car #Ent))))))
          :vlax-false
        ) ;_ vla-put-layeron
       )
       ((vl-position #Ent '("C" "c"))
        (vla-put-layeron (vlax-ename->vla-object (tblobjname "layer" (getvar "clayer"))) :vlax-false)
       )
     ) ;_ cond
  ) ;_ while
  (princ)
) ;_ defun



Updated: 10.15.09
Title: Re: NEntsel with hovering object layer name cursor display
Post by: Andrea on October 19, 2009, 03:43:51 PM
nice code Mr. Thompspon...

;-)
Title: Re: NEntsel with hovering object layer name cursor display
Post by: alanjt on October 19, 2009, 03:45:21 PM
nice code Mr. Thompspon...

;-)
Thanks :)
LoL
Pretty bad when I can't even spell my own name correctly.
Title: Re: NEntsel with hovering object layer name cursor display
Post by: Lee Mac on October 20, 2009, 07:26:22 AM
Hey Alan,

Very nice idea  :-)  Reminds me of the Dinfo.lsp I posted here a few months back   :wink:

Just a quick one, but you can use vla-put-insertionpoint, in place of vla-move in your grRead loop if you so wish  :-)

Lee
Title: Re: NEntsel with hovering object layer name cursor display
Post by: alanjt on October 20, 2009, 08:24:50 AM
Hey Alan,

Very nice idea  :-)  Reminds me of the Dinfo.lsp I posted here a few months back   :wink:

Just a quick one, but you can use vla-put-insertionpoint, in place of vla-move in your grRead loop if you so wish  :-)

Lee
Thanks, I was wanting something to display the layer for Layer control routines.

I didn't think about just vla-put-InsertionPoint, save me the trouble of having to vla-get-InsertionPoint for the vla-move basepoint.
Title: Re: NEntsel with hovering object layer name cursor display
Post by: alanjt on October 20, 2009, 09:17:22 AM
Updated (above) to replace use of vla-move with vla-put-insertionpoint, per Lee's comment.
Title: Re: NEntsel with hovering object layer name cursor display
Post by: GDF on October 20, 2009, 11:20:59 AM
Very kool routine. I get lost in the vla- and lamda stuff...a great exmple to learn from. Thanks for sharing it.
Title: Re: NEntsel with hovering object layer name cursor display
Post by: alanjt on October 20, 2009, 11:31:14 PM
Very kool routine. I get lost in the vla- and lamda stuff...a great exmple to learn from. Thanks for sharing it.
Thank Gary. :)

Updated (above) to accept keywords keyletters (for now).
Title: Re: Entsel/NEntsel with hovering object layer name cursor display
Post by: alanjt on October 21, 2009, 12:33:01 AM
Updated to allow user to use NEntsel or Entsel.
Kind of clunk when working with xrefs that have a lot of stuff, but not sure how to fix that.
Title: Re: Entsel/NEntsel with hovering object layer name cursor display
Post by: RIOGHAN on October 28, 2009, 09:03:50 AM
Hey this is a really cool little program.  Thanks.  I added this little piece in your code, by pressing TAB is toggles between nested layers and non-nested layers.

Code: [Select]
;;; Entsel/NEntsel with display of layer name of object on mouse over and optional keyword
;;; #Nested - T for nested selection, nil if not
;;; #Prompt - Prompt string to display, when not displaying object's layer name
;;; #Keywords - Comma delimited key letters or nil to ignore (ie: "A,b" to match A, a, B or b
;;; Alan J. Thompson, 10.20.09
(defun AT:EntselLayerDisplay
       (#Nested #Prompt #Keywords / *error* #Layer #Prompt #Text #Read #Temp #Final)
  (setq *error* (lambda (x) (and #Text (vl-catch-all-apply 'vla-delete (list #Text))))
        #Layer  (vlax-ename->vla-object (tblobjname "layer" "0"))
  ) ;_ setq
  (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
  (or #Prompt (setq #Prompt "Select object: "))
  (or (eq (getvar 'clayer) "0") (vla-put-freeze #Layer :vlax-false))
  (vla-put-lock #Layer :vlax-false)
  (vla-put-layeron #Layer :vlax-true)
  (setq #Text (vlax-ename->vla-object
                (entmakex (list '(0 . "MTEXT")
                                '(100 . "AcDbEntity")
                                '(100 . "AcDbMText")
                                '(8 . "0")
                                '(62 . 250)
                                '(90 . 1)
                                '(63 . 7)
                                '(45 . 1.3)
                                (cons 40 (* (getvar "viewsize") 0.013))
                                (cons 10 (trans (cadr (grread T 15 0)) 1 0))
                          ) ;_ list
                ) ;_ entmakex
              ) ;_ vlax-ename->vla-object
  ) ;_ setq
  (vl-catch-all-apply
    '(lambda ()
       (vlax-invoke
         (vla-AddObject
           (vla-GetExtensionDictionary
             (if (or (eq acmodelspace (vla-get-activespace *AcadDoc*))
                     (eq :vlax-true (vla-get-mspace *AcadDoc*))
                 ) ;_ or
               (vla-get-modelspace *AcadDoc*)
               (vla-get-paperspace *AcadDoc*)
             ) ;_ if
           ) ;_ vla-GetExtensionDictionary
           "ACAD_SORTENTS"
           "AcDbSortentsTable"
         ) ;_ vla-AddObject
         'MoveToTop
         (list #Text)
       ) ;_ vlax-invoke
     ) ;_ lambda
  ) ;_ vl-catch-all-apply
  (while (and (setq #Read (grread T 15 2))
              (/= (cadr #Read) 13)
              (/= (car #Read) 25)
              (not (vl-position (cadr #Read) '(13 158)))
              (not #Final)
         ) ;_ and
    (cond
      [color=red]((and (eq (car #Read) 2)(eq 9 (cadr #Read)));Click <TAB> to toggle between nested and non-nested
       (setq #Nested (not #Nested))
       ) [/color]
      ((eq 5 (car #Read))
       (vla-put-insertionpoint
         #Text
         (vlax-3d-point (polar (trans (cadr #Read) 1 0) (* pi 1.75) (* (getvar "viewsize") 0.02)))
       ) ;_ vla-put-insertionpoint
       (vla-put-height #Text (* (getvar "viewsize") 0.013))
       (if (setq #Ent (nentselp (cadr #Read)))
         (if #Nested
           (vla-put-textstring #Text (cdr (assoc 8 (entget (car #Ent)))))
           (cond
             ((eq (length #Ent) 2) (vla-put-textstring #Text (cdr (assoc 8 (entget (car #Ent))))))
             ((eq (length #Ent) 4)
              (vla-put-textstring #Text (cdr (assoc 8 (entget (car (car (reverse #Ent)))))))
             )
           ) ;_ cond
         ) ;_ if
         (vla-put-textstring #Text #Prompt)
       ) ;_ if
      )
      ((eq 3 (car #Read))
       (if (setq #Temp (nentselp (cadr #Read)))
         (progn
           (or #Nested
               (and (eq 4 (length #Temp))
                    (setq #Temp (list (car (car (reverse #Temp))) (cadr #Temp)))
               ) ;_ and
           ) ;_ or
           (or (eq (vla-get-objectid (vlax-ename->vla-object (car #Temp)))
                   (vla-get-objectid #Text)
               ) ;_ eq
               (setq #Final #Temp)
           ) ;_ or
         ) ;_ progn
       ) ;_ if
      )
      ((and #Keywords (eq (car #Read) 2))
       (if (wcmatch (strcase (chr (cadr #Read))) (strcase #Keywords))
         (setq #Final (chr (cadr #Read)))
       ) ;_ if
      )
    ) ;_ cond
  ) ;_ while
  (*error* nil)
  #Final
) ;_ defun
Title: Re: Entsel/NEntsel with hovering object layer name cursor display
Post by: alanjt on October 28, 2009, 10:49:52 AM
Thanks, I'm glad you like it.
Cool idea. :)
Have you tried it with any xrefs? I'm curious about the performance.

Hey this is a really cool little program.  Thanks.  I added this little piece in your code, by pressing TAB is toggles between nested layers and non-nested layers.

Code: [Select]
;;; Entsel/NEntsel with display of layer name of object on mouse over and optional keyword
;;; #Nested - T for nested selection, nil if not
;;; #Prompt - Prompt string to display, when not displaying object's layer name
;;; #Keywords - Comma delimited key letters or nil to ignore (ie: "A,b" to match A, a, B or b
;;; Alan J. Thompson, 10.20.09
(defun AT:EntselLayerDisplay
       (#Nested #Prompt #Keywords / *error* #Layer #Prompt #Text #Read #Temp #Final)
  (setq *error* (lambda (x) (and #Text (vl-catch-all-apply 'vla-delete (list #Text))))
        #Layer  (vlax-ename->vla-object (tblobjname "layer" "0"))
  ) ;_ setq
  (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
  (or #Prompt (setq #Prompt "Select object: "))
  (or (eq (getvar 'clayer) "0") (vla-put-freeze #Layer :vlax-false))
  (vla-put-lock #Layer :vlax-false)
  (vla-put-layeron #Layer :vlax-true)
  (setq #Text (vlax-ename->vla-object
                (entmakex (list '(0 . "MTEXT")
                                '(100 . "AcDbEntity")
                                '(100 . "AcDbMText")
                                '(8 . "0")
                                '(62 . 250)
                                '(90 . 1)
                                '(63 . 7)
                                '(45 . 1.3)
                                (cons 40 (* (getvar "viewsize") 0.013))
                                (cons 10 (trans (cadr (grread T 15 0)) 1 0))
                          ) ;_ list
                ) ;_ entmakex
              ) ;_ vlax-ename->vla-object
  ) ;_ setq
  (vl-catch-all-apply
    '(lambda ()
       (vlax-invoke
         (vla-AddObject
           (vla-GetExtensionDictionary
             (if (or (eq acmodelspace (vla-get-activespace *AcadDoc*))
                     (eq :vlax-true (vla-get-mspace *AcadDoc*))
                 ) ;_ or
               (vla-get-modelspace *AcadDoc*)
               (vla-get-paperspace *AcadDoc*)
             ) ;_ if
           ) ;_ vla-GetExtensionDictionary
           "ACAD_SORTENTS"
           "AcDbSortentsTable"
         ) ;_ vla-AddObject
         'MoveToTop
         (list #Text)
       ) ;_ vlax-invoke
     ) ;_ lambda
  ) ;_ vl-catch-all-apply
  (while (and (setq #Read (grread T 15 2))
              (/= (cadr #Read) 13)
              (/= (car #Read) 25)
              (not (vl-position (cadr #Read) '(13 158)))
              (not #Final)
         ) ;_ and
    (cond
      [color=red]((and (eq (car #Read) 2)(eq 9 (cadr #Read)));Click <TAB> to toggle between nested and non-nested
       (setq #Nested (not #Nested))
       ) [/color]
      ((eq 5 (car #Read))
       (vla-put-insertionpoint
         #Text
         (vlax-3d-point (polar (trans (cadr #Read) 1 0) (* pi 1.75) (* (getvar "viewsize") 0.02)))
       ) ;_ vla-put-insertionpoint
       (vla-put-height #Text (* (getvar "viewsize") 0.013))
       (if (setq #Ent (nentselp (cadr #Read)))
         (if #Nested
           (vla-put-textstring #Text (cdr (assoc 8 (entget (car #Ent)))))
           (cond
             ((eq (length #Ent) 2) (vla-put-textstring #Text (cdr (assoc 8 (entget (car #Ent))))))
             ((eq (length #Ent) 4)
              (vla-put-textstring #Text (cdr (assoc 8 (entget (car (car (reverse #Ent)))))))
             )
           ) ;_ cond
         ) ;_ if
         (vla-put-textstring #Text #Prompt)
       ) ;_ if
      )
      ((eq 3 (car #Read))
       (if (setq #Temp (nentselp (cadr #Read)))
         (progn
           (or #Nested
               (and (eq 4 (length #Temp))
                    (setq #Temp (list (car (car (reverse #Temp))) (cadr #Temp)))
               ) ;_ and
           ) ;_ or
           (or (eq (vla-get-objectid (vlax-ename->vla-object (car #Temp)))
                   (vla-get-objectid #Text)
               ) ;_ eq
               (setq #Final #Temp)
           ) ;_ or
         ) ;_ progn
       ) ;_ if
      )
      ((and #Keywords (eq (car #Read) 2))
       (if (wcmatch (strcase (chr (cadr #Read))) (strcase #Keywords))
         (setq #Final (chr (cadr #Read)))
       ) ;_ if
      )
    ) ;_ cond
  ) ;_ while
  (*error* nil)
  #Final
) ;_ defun

Title: Re: Entsel/NEntsel with hovering object layer name cursor display
Post by: RIOGHAN on October 28, 2009, 12:16:53 PM
I used it to turn off/freeze some xref'd layers and it seems to work good.  How would I get the prompt to show up to at 0° relative to the screen instead of the WCS.  I am sure it has something to do with viewtwist, but my brain decided to stay at home today.

Title: Re: Entsel/NEntsel with hovering object layer name cursor display
Post by: RIOGHAN on October 28, 2009, 01:19:03 PM
Ahhh....coffee does wonders for the brain.  I think I got the angle thing sorted out.

Code: [Select]
;;; Entsel/NEntsel with display of layer name of object on mouse over and optional keyword
;;; #Nested - T for nested selection, nil if not
;;; #Prompt - Prompt string to display, when not displaying object's layer name
;;; #Keywords - Comma delimited key letters or nil to ignore (ie: "A,b" to match A, a, B or b
;;; Alan J. Thompson, 10.20.09
(defun AT:EntselLayerDisplay
       (#Nested #Prompt #Keywords / *error* #Layer #Prompt #Text #Read #Temp #Final)
  (setq *error* (lambda (x) (and #Text (vl-catch-all-apply 'vla-delete (list #Text))))
        #Layer  (vlax-ename->vla-object (tblobjname "layer" "0"))
  ) ;_ setq
  (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
  (or #Prompt (setq #Prompt "Select object: "))
  (or (eq (getvar 'clayer) "0") (vla-put-freeze #Layer :vlax-false))
  (vla-put-lock #Layer :vlax-false)
  (vla-put-layeron #Layer :vlax-true)
  (setq #Text (vlax-ename->vla-object
                (entmakex (list '(0 . "MTEXT")
                                '(100 . "AcDbEntity")
                                '(100 . "AcDbMText")
                                '(8 . "0")
                                '(62 . 250)
                                '(90 . 1)
                                '(63 . 7)
                                '(45 . 1.3)
                                (cons 40 (* (getvar "viewsize") 0.013))
                                [color=blue](cons 50 (- (* 2 pi) (getvar "viewtwist")))[/color]
                                (cons 10 (trans (cadr (grread T 15 0)) 1 0))
                          ) ;_ list
                ) ;_ entmakex
              ) ;_ vlax-ename->vla-object
  ) ;_ setq
  (vl-catch-all-apply
    '(lambda ()
       (vlax-invoke
         (vla-AddObject
           (vla-GetExtensionDictionary
             (if (or (eq acmodelspace (vla-get-activespace *AcadDoc*))
                     (eq :vlax-true (vla-get-mspace *AcadDoc*))
                 ) ;_ or
               (vla-get-modelspace *AcadDoc*)
               (vla-get-paperspace *AcadDoc*)
             ) ;_ if
           ) ;_ vla-GetExtensionDictionary
           "ACAD_SORTENTS"
           "AcDbSortentsTable"
         ) ;_ vla-AddObject
         'MoveToTop
         (list #Text)
       ) ;_ vlax-invoke
     ) ;_ lambda
  ) ;_ vl-catch-all-apply
  (while (and (setq #Read (grread T 15 2))
              (/= (cadr #Read) 13)
              (/= (car #Read) 25)
              (not (vl-position (cadr #Read) '(13 158)))
              (not #Final)
         ) ;_ and
    (cond
      ((and (eq (car #Read) 2)(eq 9 (cadr #Read)));Click <TAB> to toggle between nested and non-nested
       (setq #Nested (not #Nested))
       )
      ((eq 5 (car #Read))
       (vla-put-insertionpoint
         #Text
         (vlax-3d-point (polar (trans (cadr #Read) 1 0)  [color=blue](- (* 3.75 pi)(getvar "viewtwist"))[/color] (* (getvar "viewsize") 0.02)))
       ) ;_ vla-put-insertionpoint
       (vla-put-height #Text (* (getvar "viewsize") 0.013))
       (if (setq #Ent (nentselp (cadr #Read)))
         (if #Nested
           (vla-put-textstring #Text (cdr (assoc 8 (entget (car #Ent)))))
           (cond
             ((eq (length #Ent) 2) (vla-put-textstring #Text (cdr (assoc 8 (entget (car #Ent))))))
             ((eq (length #Ent) 4)
              (vla-put-textstring #Text (cdr (assoc 8 (entget (car (car (reverse #Ent)))))))
             )
           ) ;_ cond
         ) ;_ if
         (vla-put-textstring #Text #Prompt)
       ) ;_ if
      )
      ((eq 3 (car #Read))
       (if (setq #Temp (nentselp (cadr #Read)))
         (progn
           (or #Nested
               (and (eq 4 (length #Temp))
                    (setq #Temp (list (car (car (reverse #Temp))) (cadr #Temp)))
               ) ;_ and
           ) ;_ or
           (or (eq (vla-get-objectid (vlax-ename->vla-object (car #Temp)))
                   (vla-get-objectid #Text)
               ) ;_ eq
               (setq #Final #Temp)
           ) ;_ or
         ) ;_ progn
       ) ;_ if
      )
      ((and #Keywords (eq (car #Read) 2))
       (if (wcmatch (strcase (chr (cadr #Read))) (strcase #Keywords))
         (setq #Final (chr (cadr #Read)))
       ) ;_ if
      )
    ) ;_ cond
  ) ;_ while
  (*error* nil)
  #Final
) ;_ defun
Title: Re: Entsel/NEntsel with hovering object layer name cursor display
Post by: CAB on October 29, 2009, 11:08:49 AM
This worked better for me:
Removed some dxf codes for ACAD2000 compatibility
Original mtext position is not critical so created at '(0 0 0)
Original angle is zero, acad will adjust for current UCS

Offset angle is calculated via the x-axis

Code: [Select]
;;; Entsel/NEntsel with display of layer name of object on mouse over and optional keyword
;;; #Nested - T for nested selection, nil if not
;;; #Prompt - Prompt string to display, when not displaying object's layer name
;;; #Keywords - Comma delimited key letters or nil to ignore (ie: "A,b" to match A, a, B or b
;;; Alan J. Thompson, 10.20.09
;;; 10.29.09 CAB modified
(defun AT:EntselLayerDisplay
       (#Nested #Prompt #Keywords / *error* #Layer #Prompt #Text #Read #Temp #Final)
  (setq *error* (lambda (x) (and #Text (vl-catch-all-apply 'vla-delete (list #Text))))
        #Layer  (vlax-ename->vla-object (tblobjname "layer" "0"))
  ) ;_ setq
  (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
  (or #Prompt (setq #Prompt "Select object: "))
  (or (eq (getvar 'clayer) "0") (vla-put-freeze #Layer :vlax-false))
  (vla-put-lock #Layer :vlax-false)
  (vla-put-layeron #Layer :vlax-true)
  (setq #Text (vlax-ename->vla-object
                (entmakex (list '(0 . "MTEXT")
                                '(100 . "AcDbEntity")
                                '(100 . "AcDbMText")
                                '(8 . "0")
                                [color=blue];'(62 . 250) ; CAB removed
                                ;'(90 . 1)   ; CAB removed no workie in ACAD2000
                                ;'(63 . 7)   ; CAB removed no workie in ACAD2000
                                ;'(45 . 1.3) ; CAB removed no workie in ACAD2000[/color]
                                (cons 40 (* (getvar "viewsize") 0.013))
                                (cons 50 0.0)
                                [color=blue]'(10 0 0 0);(trans (cadr (grread T 15 0)) 1 0)) ; CAB modified[/color]
                          ) ;_ list
                ) ;_ entmakex
              ) ;_ vlax-ename->vla-object
  ) ;_ setq
  (vl-catch-all-apply
    '(lambda ()
       (vlax-invoke
         (vla-AddObject
           (vla-GetExtensionDictionary
             (if (or (eq acmodelspace (vla-get-activespace *AcadDoc*))
                     (eq :vlax-true (vla-get-mspace *AcadDoc*))
                 ) ;_ or
               (vla-get-modelspace *AcadDoc*)
               (vla-get-paperspace *AcadDoc*)
             ) ;_ if
           ) ;_ vla-GetExtensionDictionary
           "ACAD_SORTENTS"
           "AcDbSortentsTable"
         ) ;_ vla-AddObject
         'MoveToTop
         (list #Text)
       ) ;_ vlax-invoke
     ) ;_ lambda
  ) ;_ vl-catch-all-apply
  (while (and (setq #Read (grread T 15 2))
              (/= (cadr #Read) 13)
              (/= (car #Read) 25)
              (not (vl-position (cadr #Read) '(13 158)))
              (not #Final)
         ) ;_ and
    (cond
      ((and (eq (car #Read) 2)(eq 9 (cadr #Read)));Click <TAB> to toggle between nested and non-nested
       (setq #Nested (not #Nested))
       )  
      ((eq 5 (car #Read))
       (vla-put-insertionpoint
         #Text
         (vlax-3d-point (polar (trans (cadr #Read) 1 0)
                               [color=blue](angle '(0 0) (trans (getvar "UCSXDIR") 0 (trans '(0 0 1) 1 0 T))) ; CAB modified[/color]
                               (* (getvar "viewsize") 0.02)))
       ) ;_ vla-put-insertionpoint
       (vla-put-height #Text (* (getvar "viewsize") 0.013))
       (if (setq #Ent (nentselp (cadr #Read)))
         (if #Nested
           (vla-put-textstring #Text (cdr (assoc 8 (entget (car #Ent)))))
           (cond
             ((eq (length #Ent) 2) (vla-put-textstring #Text (cdr (assoc 8 (entget (car #Ent))))))
             ((eq (length #Ent) 4)
              (vla-put-textstring #Text (cdr (assoc 8 (entget (car (car (reverse #Ent)))))))
             )
           ) ;_ cond
         ) ;_ if
         (vla-put-textstring #Text #Prompt)
       ) ;_ if
      )
      ((eq 3 (car #Read))
       (if (setq #Temp (nentselp (cadr #Read)))
         (progn
           (or #Nested
               (and (eq 4 (length #Temp))
                    (setq #Temp (list (car (car (reverse #Temp))) (cadr #Temp)))
               ) ;_ and
           ) ;_ or
           (or (eq (vla-get-objectid (vlax-ename->vla-object (car #Temp)))
                   (vla-get-objectid #Text)
               ) ;_ eq
               (setq #Final #Temp)
           ) ;_ or
         ) ;_ progn
       ) ;_ if
      )
      ((and #Keywords (eq (car #Read) 2))
       (if (wcmatch (strcase (chr (cadr #Read))) (strcase #Keywords))
         (setq #Final (chr (cadr #Read)))
       ) ;_ if
      )
    ) ;_ cond
  ) ;_ while
  (*error* nil)
  #Final
) ;_ defun
Title: Re: Entsel/NEntsel with hovering object layer name cursor display
Post by: alanjt on October 29, 2009, 12:28:33 PM
This worked better for me:
Removed some dxf codes for ACAD2000 compatibility
Original mtext position is not critical so created at '(0 0 0)
Original angle is zero, acad will adjust for current UCS

Offset angle is calculated via the x-axis

Code: [Select]
;;; Entsel/NEntsel with display of layer name of object on mouse over and optional keyword
;;; #Nested - T for nested selection, nil if not
;;; #Prompt - Prompt string to display, when not displaying object's layer name
;;; #Keywords - Comma delimited key letters or nil to ignore (ie: "A,b" to match A, a, B or b
;;; Alan J. Thompson, 10.20.09
;;; 10.29.09 CAB modified
(defun AT:EntselLayerDisplay
       (#Nested #Prompt #Keywords / *error* #Layer #Prompt #Text #Read #Temp #Final)
  (setq *error* (lambda (x) (and #Text (vl-catch-all-apply 'vla-delete (list #Text))))
        #Layer  (vlax-ename->vla-object (tblobjname "layer" "0"))
  ) ;_ setq
  (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
  (or #Prompt (setq #Prompt "Select object: "))
  (or (eq (getvar 'clayer) "0") (vla-put-freeze #Layer :vlax-false))
  (vla-put-lock #Layer :vlax-false)
  (vla-put-layeron #Layer :vlax-true)
  (setq #Text (vlax-ename->vla-object
                (entmakex (list '(0 . "MTEXT")
                                '(100 . "AcDbEntity")
                                '(100 . "AcDbMText")
                                '(8 . "0")
                                [color=blue];'(62 . 250) ; CAB removed
                                ;'(90 . 1)   ; CAB removed no workie in ACAD2000
                                ;'(63 . 7)   ; CAB removed no workie in ACAD2000
                                ;'(45 . 1.3) ; CAB removed no workie in ACAD2000[/color]
                                (cons 40 (* (getvar "viewsize") 0.013))
                                (cons 50 0.0)
                                [color=blue]'(10 0 0 0);(trans (cadr (grread T 15 0)) 1 0)) ; CAB modified[/color]
                          ) ;_ list
                ) ;_ entmakex
              ) ;_ vlax-ename->vla-object
  ) ;_ setq
  (vl-catch-all-apply
    '(lambda ()
       (vlax-invoke
         (vla-AddObject
           (vla-GetExtensionDictionary
             (if (or (eq acmodelspace (vla-get-activespace *AcadDoc*))
                     (eq :vlax-true (vla-get-mspace *AcadDoc*))
                 ) ;_ or
               (vla-get-modelspace *AcadDoc*)
               (vla-get-paperspace *AcadDoc*)
             ) ;_ if
           ) ;_ vla-GetExtensionDictionary
           "ACAD_SORTENTS"
           "AcDbSortentsTable"
         ) ;_ vla-AddObject
         'MoveToTop
         (list #Text)
       ) ;_ vlax-invoke
     ) ;_ lambda
  ) ;_ vl-catch-all-apply
  (while (and (setq #Read (grread T 15 2))
              (/= (cadr #Read) 13)
              (/= (car #Read) 25)
              (not (vl-position (cadr #Read) '(13 158)))
              (not #Final)
         ) ;_ and
    (cond
      ((and (eq (car #Read) 2)(eq 9 (cadr #Read)));Click <TAB> to toggle between nested and non-nested
       (setq #Nested (not #Nested))
       ) 
      ((eq 5 (car #Read))
       (vla-put-insertionpoint
         #Text
         (vlax-3d-point (polar (trans (cadr #Read) 1 0)
                               [color=blue](angle '(0 0) (trans (getvar "UCSXDIR") 0 (trans '(0 0 1) 1 0 T))) ; CAB modified[/color]
                               (* (getvar "viewsize") 0.02)))
       ) ;_ vla-put-insertionpoint
       (vla-put-height #Text (* (getvar "viewsize") 0.013))
       (if (setq #Ent (nentselp (cadr #Read)))
         (if #Nested
           (vla-put-textstring #Text (cdr (assoc 8 (entget (car #Ent)))))
           (cond
             ((eq (length #Ent) 2) (vla-put-textstring #Text (cdr (assoc 8 (entget (car #Ent))))))
             ((eq (length #Ent) 4)
              (vla-put-textstring #Text (cdr (assoc 8 (entget (car (car (reverse #Ent)))))))
             )
           ) ;_ cond
         ) ;_ if
         (vla-put-textstring #Text #Prompt)
       ) ;_ if
      )
      ((eq 3 (car #Read))
       (if (setq #Temp (nentselp (cadr #Read)))
         (progn
           (or #Nested
               (and (eq 4 (length #Temp))
                    (setq #Temp (list (car (car (reverse #Temp))) (cadr #Temp)))
               ) ;_ and
           ) ;_ or
           (or (eq (vla-get-objectid (vlax-ename->vla-object (car #Temp)))
                   (vla-get-objectid #Text)
               ) ;_ eq
               (setq #Final #Temp)
           ) ;_ or
         ) ;_ progn
       ) ;_ if
      )
      ((and #Keywords (eq (car #Read) 2))
       (if (wcmatch (strcase (chr (cadr #Read))) (strcase #Keywords))
         (setq #Final (chr (cadr #Read)))
       ) ;_ if
      )
    ) ;_ cond
  ) ;_ while
  (*error* nil)
  #Final
) ;_ defun


(cons 50 0.0) Didn't think about worrying about that. I tested for nonwcs, but never rotated my view.
How would I correct angle if viewtwist wasn't zero, but on WCS? Playing around, I tried this crazyness. It worked....sort of:
Code: [Select]
(and (not (zerop (getvar "viewtwist"))) (not (zerop (getvar "worlducs"))) (vla-put-rotation #Text (+ pi (- pi (getvar "viewtwist")))))
Guess I'd better get back on this one, I didn't really think anyone would find it useful.