TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started 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).
;;; 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:
;;; 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
;;; 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
-
nice code Mr. Thompspon...
;-)
-
nice code Mr. Thompspon...
;-)
Thanks :)
LoL
Pretty bad when I can't even spell my own name correctly.
-
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
-
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.
-
Updated (above) to replace use of vla-move with vla-put-insertionpoint, per Lee's comment.
-
Very kool routine. I get lost in the vla- and lamda stuff...a great exmple to learn from. Thanks for sharing it.
-
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).
-
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.
-
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.
;;; 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
-
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.
;;; 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
-
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.
-
Ahhh....coffee does wonders for the brain. I think I got the angle thing sorted out.
;;; 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
-
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
;;; 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
-
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
;;; 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:
(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.