|
|
(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;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; |
|
发表于 2024-6-22 09:46:18
