Author Topic: Entsel/NEntsel with hovering object layer name cursor display  (Read 6171 times)

0 Members and 1 Guest are viewing this topic.

alanjt

  • Needs a day job
  • Posts: 5327
  • Standby for witty remark...
Entsel/NEntsel with hovering object layer name cursor display
« 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
« Last Edit: October 21, 2009, 12:31:47 AM by alanjt »
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

Andrea

  • Water Moccasin
  • Posts: 2360
Re: NEntsel with hovering object layer name cursor display
« Reply #1 on: October 19, 2009, 03:43:51 PM »
nice code Mr. Thompspon...

;-)
Keep smile...

alanjt

  • Needs a day job
  • Posts: 5327
  • Standby for witty remark...
Re: NEntsel with hovering object layer name cursor display
« Reply #2 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.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

Lee Mac

  • Seagull
  • Posts: 12270
  • London, England
Re: NEntsel with hovering object layer name cursor display
« Reply #3 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

alanjt

  • Needs a day job
  • Posts: 5327
  • Standby for witty remark...
Re: NEntsel with hovering object layer name cursor display
« Reply #4 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.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

alanjt

  • Needs a day job
  • Posts: 5327
  • Standby for witty remark...
Re: NEntsel with hovering object layer name cursor display
« Reply #5 on: October 20, 2009, 09:17:22 AM »
Updated (above) to replace use of vla-move with vla-put-insertionpoint, per Lee's comment.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

GDF

  • Water Moccasin
  • Posts: 1992
Re: NEntsel with hovering object layer name cursor display
« Reply #6 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.
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2019x64 Windows 10x64

alanjt

  • Needs a day job
  • Posts: 5327
  • Standby for witty remark...
Re: NEntsel with hovering object layer name cursor display
« Reply #7 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).
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

alanjt

  • Needs a day job
  • Posts: 5327
  • Standby for witty remark...
Re: Entsel/NEntsel with hovering object layer name cursor display
« Reply #8 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.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

RIOGHAN

  • Guest
Re: Entsel/NEntsel with hovering object layer name cursor display
« Reply #9 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

alanjt

  • Needs a day job
  • Posts: 5327
  • Standby for witty remark...
Re: Entsel/NEntsel with hovering object layer name cursor display
« Reply #10 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

Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

RIOGHAN

  • Guest
Re: Entsel/NEntsel with hovering object layer name cursor display
« Reply #11 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.


RIOGHAN

  • Guest
Re: Entsel/NEntsel with hovering object layer name cursor display
« Reply #12 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
« Last Edit: October 29, 2009, 07:48:23 AM by Rioghan »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10366
Re: Entsel/NEntsel with hovering object layer name cursor display
« Reply #13 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
« Last Edit: October 29, 2009, 11:14:23 AM by CAB »
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

alanjt

  • Needs a day job
  • Posts: 5327
  • Standby for witty remark...
Re: Entsel/NEntsel with hovering object layer name cursor display
« Reply #14 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.
« Last Edit: October 29, 2009, 12:32:06 PM by alanjt »
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox