Hey all,
I've got a program (mostly composed of stolen code with minor modifications) that will display 'xlist' properties by the cursor during object selection. The problem is, currently, I'm using this little bit of code...(cons 7 "ARIAL")...and it will use the active font during property display if Arial isn't available. I found a function called "af" by ronjonp that would make the arial font active but it was not compatible with 2009 and wouldn't stay consistent as far as the font selected in 2008.
I'm not very experienced and i'm sure something simple can be done to fix the problem. Any Ideas?
Here's the code i'm using now
(defun c:ch (/ ActDoc e el kword lyr clr layer linetype obj sObjectType sLineType sColor sBlockname
sStyleName *error*)
(vl-load-com)
(defun *error* ( msg )
(princ (strcat "\n<" msg ">\n"))
(progn
(and TextENAME (entdel TextENAME))
(vl-cmdf "ucs" "p")
(vla-EndUndoMark ActDoc)
);progn
(princ)
)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-EndUndoMark ActDoc)
(vla-StartUndoMark ActDoc)
(while (null e) (princ "\nSelect Object on Layer to change: ")
(setq e (test2))
);while
(setq el (entget e))
(setq lyr (cdr (assoc 8 el)))
(progn
(setq layer (entget
(tblobjname "layer" lyr)
)
)
(if (assoc 420 layer)(setq layer (vl-remove (assoc 420 layer) layer)));;new line attached to prevent
true color override
(initget "Color lineType lineWeight")
(setq kword (if
(setq kword (getkword (strcat "Modify " lyr " [ Color / lineType / lineWeight ]:
<Color>")))
kword "Color")
);setq
(cond
((= kword "Color")
(setq clr (acad_colordlg 0))
(entmod (subst (cons 62 clr) (assoc 62 layer) layer))
);cond 1
((= kword "lineType")
(setq LineTYPE (GetLineType))
(if (/= (getvar "celtype") LineTYPE)
(entmod (subst (cons 6 linetype) (assoc 6 layer) layer))
)
);cond 2
((= kword "lineWeight")
(setq Lineweight (GetLineweight))
(entmod (subst (cons 370 lineweight) (assoc 370 layer) layer))
(vl-cmdf "undo" "")
(vl-cmdf "redo" "")
);cond 3
);condition
);progn
(vl-cmdf "ucs" "p")
(vla-Regen ActDoc acActiveViewport)
(vla-EndUndoMark ActDoc)
(princ)
);defun
;;;;;function test2 Originally by Vovka @ theswamp.org;added viewtwist/ucs world command, xlist code,
and modified viewsize for compatability while in locked $VP
(defun test2 (/ ENAME TextENAME ViewSize sLayer sObjectType sBlockname sStyel Name layer)
(vl-cmdf "ucs" "w")
(while (and (setq Input (grread T 4 2)) (= (car Input) 5))
(if TextENAME
(progn (entdel TextENAME) (setq TextENAME nil))
)
(if (and (setq ENAME (car (nentselp (cadr Input))))
(not (eq TextENAME ENAME))
)
(progn (if (or (= (getvar "ctab") "Model")(= (getvar "CVPORT") 1))
(setq viewsize (getvar "VIEWSIZE"))
(setq viewsize (* (/ (getvar "viewsize")(car (getvar "screensize"))) 500))
);if
(setq el (entget ename))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;THIS SECTION IS FROM
XLIST;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if ename
(progn
(setq el (entget ename)
sLayer (cdr (assoc 8 el))
sObjectType (cdr (assoc 0 el))
sLineType (cdr (assoc 6 el)) ; This is optional, we check for it
later.
sColor (cdr (assoc 62 el))
sBlockname ""
sStyleName ""
layer (entget
(tblobjname "layer" SLayer)
)
);setq
;Check for no linetype override, in which case it is bylayer.
(if (= sLineType nil) (setq sLineType "ByLayer")) ;Tidy up the optional DXF
codes for linetype
;If the object is a vertex, call a vertex a polyline
(if (= "VERTEX" sObjectType) (setq sObjectType "POLYLINE"))
;If the object is a block, call an insert a block and find out the block name
(if (= "INSERT" sObjectType)
(progn
(setq sObjectType "BLOCK"
sBlockname (cdr (assoc 2 el))
)
);end progn
);end if
;If the object is text or mtext, find out the style name
(if (or (= "TEXT" sObjectType) (= "MTEXT" sObjectType))
(setq sStyleName (cdr (assoc 7 el)))
);end if
; Sort out the colors and assign names to the first 8 plus bylayer and byblock
(cond ( (= nil sColor) (setq sColor "ByLayer"))
( (= 0 sColor) (setq sColor "ByBlock"))
( (= 1 sColor) (setq sColor "Red"))
( (= 2 sColor) (setq sColor "Yellow"))
( (= 3 sColor) (setq sColor "Green"))
( (= 4 sColor) (setq sColor "Cyan"))
( (= 5 sColor) (setq sColor "Blue"))
( (= 6 sColor) (setq sColor "Magenta"))
( (= 7 sColor) (setq sColor "White"))
( (= 256 sColor) (setq sColor "ByLayer"))
(t (setq sColor (itoa sColor)))
);end cond
);progn
);if
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq TextENAME
(entmakex
(list
(cons 0 "MTEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbMText")
(cons 1
(cond ((and (/= sLineType "ByLayer")(/= sColor "ByLayer"))
(strcat "OBJECT: "
sObjectType
;"\nENAME: "
; (vl-princ-to-string ename)
"\nLAYER: "
(cdr (assoc 8 (entget ename)))
"\nLINETYPE: "
sLineType
"\nCOLOR: "
sColor
);strcat
);condition
((and (= sLineType "ByLayer")(= sColor "ByLayer"))
(strcat "OBJECT: "
sObjectType
;"\nENAME: "
; (vl-princ-to-string ename)
"\nLAYER: "
(cdr (assoc 8 (entget ename)))
"\nLINETYPE: "
sLineType " (" (cdr (assoc 6 layer)) ")"
"\nCOLOR: "
sColor " (" (itoa (cdr (assoc 62 layer))) ")"
);strcat
);condition
((and (= sLineType "ByLayer")(/= sColor "ByLayer"))
(strcat "OBJECT: "
sObjectType
;"\nENAME: "
; (vl-princ-to-string ename)
"\nLAYER: "
(cdr (assoc 8 (entget ename)))
"\nLINETYPE: "
sLineType " (" (cdr (assoc 6 layer)) ")"
"\nCOLOR: "
sColor
);strcat
);condition
((and (/= sLineType "ByLayer")(= sColor "ByLayer"))
(strcat "OBJECT: "
sObjectType
;"\nENAME: "
; (vl-princ-to-string ename)
"\nLAYER: "
(cdr (assoc 8 (entget ename)))
"\nLINETYPE: "
sLineType
"\nCOLOR: "
sColor " (" (itoa (cdr (assoc 62 layer))) ")"
);strcat
);condition
);cond
)
(cons 7 "ARIAL")
(cons 10
(polar (cadr Input) 0 (/ ViewSize 50.0))
)
(cons 40 (/ ViewSize 50.0));
(cons 50 (- 0 (getvar "VIEWTWIST")));added viewtwist for readability
(cond ((and (= sLineType "ByLayer")(= sColor "ByLayer"))
(cons 62 250)
);condition
((or (/= sLineType "ByLayer")(/= sColor "ByLayer"))
(cons 62 1)
);condition
);cond
(cons 71 1)
(cons 72 5)
(cons 90 1)
(cons 63 255)
(cons 45 1.2)
);list
);entmakex
);setq
);progn
);if
);while
(and TextENAME (entdel TextENAME))
(princ)
ename;for object selection
);defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;end
test2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;
(defun GETLINETYPE (/ CL SL)
(setq CL (getvar "CELTYPE"))
(initdia)
(command "_.LINETYPE")
(while (= (logand (getvar "CMDACTIVE") 8) 1) (command pause) )
(if (/= (getvar "celtype") CL)
(setq SL (getvar "celtype"))
(setq SL CL)
)
(setvar "celtype" CL)
SL
)
(defun GETLINEWEIGHT (/ LW SLW)
(setq LW (getvar "CELWEIGHT"))
(initdia)
(vl-cmdf "_.LWEIGHT")
(while (= (logand (getvar "CMDACTIVE") 8) 1) (command pause) )
(if (/= (getvar "celweight") LW)
(setq SLW (getvar "celweight"))
(setq SLW LW)
)
(setvar "celweight" LW)
SLw
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;END LIBRARY
FUNCTIONS;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;