Change object plot style

Change object plot style

M_c3d
Advisor Advisor
928 Views
7 Replies
Message 1 of 8

Change object plot style

M_c3d
Advisor
Advisor

Hi All,

 

I am trying to change a lisp I found online that changes all object colours including blocks, so that it also changes the plot style of all these objects at the same time.

 

;Changes the colour of
;all objects in drawing
;icluding blocks and references
;;IT WILL CHANGE ALL REF ALSO MAKE BACKUP OF ALL REF BEFORE USING

(defun mip:layer-status-restore ()
(foreach item *MIP_LAYER_LST*
(if (not (vlax-erased-p (car item)))
(vl-catch-all-apply
'(lambda ()
(vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
(vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of foreach
(setq *MIP_LAYER_LST* nil)
) ;_ end of defun

(defun mip:layer-status-save ()
(setq *MIP_LAYER_LST* nil)
(vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(setq *MIP_LAYER_LST* (cons (list item
(cons "freeze" (vla-get-freeze item))
(cons "lock" (vla-get-lock item))
) ;_ end of cons
*MIP_LAYER_LST*
) ;_ end of cons
) ;_ end of setq
(vla-put-lock item :vlax-false)
(if (= (vla-get-freeze item) :vlax-true)
(vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))))
) ;_ end of vlax-for
) ;_ end of defun
(defun ChangeAllObjectsColor (Doc Color )
(vlax-for Blk (vla-get-Blocks Doc)
(if (= (vla-get-IsXref Blk) :vlax-false)
(vlax-for Obj Blk
(if (vlax-property-available-p Obj 'Color)
(vla-put-Color Obj Color)
)
)
)
)
)
(defun C:CX ( / doc col)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(mip:layer-status-save)
(if (setq col (acad_colordlg 7 t))
(ChangeAllObjectsColor doc col);_ col — color number
)
(mip:layer-status-restore)
(vla-endundomark doc)
(princ)
)
(princ "\nType CX in command line")

 

I've tried various attempts at amending the code to include this but it never seems to pick it up.


Any ideas?

 

Thanks in advance!

0 Likes
Accepted solutions (2)
929 Views
7 Replies
Replies (7)
Message 2 of 8

ВeekeeCZ
Consultant
Consultant
Accepted solution

Maybe like this?

 

;Changes the colour of
;all objects in drawing
;icluding blocks and references
;;IT WILL CHANGE ALL REF ALSO MAKE BACKUP OF ALL REF BEFORE USING

(defun mip:layer-status-restore ()
  (foreach item *MIP_LAYER_LST*
    (if (not (vlax-erased-p (car item)))
      (vl-catch-all-apply
	'(lambda ()
	   (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
	   (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
	   ) ;_ end of lambda
	) ;_ end of vl-catch-all-apply
      ) ;_ end of if
    ) ;_ end of foreach
  (setq *MIP_LAYER_LST* nil)
  ) ;_ end of defun

(defun mip:layer-status-save ()
  (setq *MIP_LAYER_LST* nil)
  (vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
    (setq *MIP_LAYER_LST* (cons (list item
				      (cons "freeze" (vla-get-freeze item))
				      (cons "lock" (vla-get-lock item))
				      ) ;_ end of cons
				*MIP_LAYER_LST*
				) ;_ end of cons
	  ) ;_ end of setq
    (vla-put-lock item :vlax-false)
    (if (= (vla-get-freeze item) :vlax-true)
      (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))))
    ) ;_ end of vlax-for
  ) ;_ end of defun
(defun ChangeAllObjectsColorStb (Doc Color Stb)
  (vlax-for Blk (vla-get-Blocks Doc)
    (if (= (vla-get-IsXref Blk) :vlax-false)
      (vlax-for Obj Blk
	(if (vlax-property-available-p Obj 'Color)
	  (vla-put-Color Obj Color))
	(if (vlax-property-available-p Obj 'PlotStyleName)
	  (vla-put-PlotStyleName Obj Stb))))))

(defun C:CX ( / doc col stb)
  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)
  (mip:layer-status-save)
  (if (and (setq col (acad_colordlg 7 t))
	   (setq stb (getstring "\nPlot style name: ")))
    (ChangeAllObjectsColorStb doc col stb);_ col — color number
    )
  (mip:layer-status-restore)
  (vla-endundomark doc)
  (princ)
  )
(princ "\nType CX in command line")
Message 3 of 8

M_c3d
Advisor
Advisor

Thanks @ВeekeeCZ that works brilliantly!

 

Is it possible to specify the plot style, i.e. Red so it doesn't need to be input?

0 Likes
Message 4 of 8

ВeekeeCZ
Consultant
Consultant
Accepted solution

Replace this line
(setq stb (getstring "\nPlot style name: ")))

 

with this one.
(setq stb "Red"))

Message 5 of 8

M_c3d
Advisor
Advisor

@ВeekeeCZ Thanks, appreciate the help.

0 Likes
Message 6 of 8

MSchille-1994
Collaborator
Collaborator

Is there a way to revise this .lsp to only have the ability to pick an object and set its layers plotstyle from a dialog box?

 

So basically, a change layers plotstyle dialog box?  I have cone for changing a layers color and I have another one to change a layers linetype, both by picking an object, then a dialog box pops up.

Attitude, not Aptitude, Determines Altitude
0 Likes
Message 7 of 8

ВeekeeCZ
Consultant
Consultant

Possibly like this.

If your using non-eng version change terms "ByLayer" "ByBlock" accordingly to your lang version. Those can't be removed from the list even not relevant.

 

(vl-load-com)

(defun c:LayerStb ( / *error* doc s i y l n o)
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if o (setvar 'cplotstyle o))
    (vla-endundomark doc)
    (princ))
  
  (if (and (or (= 0 (getvar 'pstylemode))
	       (prompt "Error: Current drawing must be in Named Plot Style mode."))
	   (setq s (ssget "_:L")))
    (repeat (setq i (sslength s))
      (setq y (cdr (assoc 8 (entget (ssname s (setq i (1- i)))))))
      (if (not (vl-position y l)) (setq l (cons y l)))))
  
  (and l
       (not (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object)))))
       (setq o (getvar 'cplotstyle))
       (setvar 'cplotstyle (getpropertyvalue (tblobjname "LAYER" (last l)) "PlotStyleName"))
       (progn
	 (initdia)
	 (command "_.plotstyle")
	 (setq n (getvar 'cplotstyle)))
       (setvar 'cplotstyle o)
       (or (not (vl-position n '("ByLayer" "ByBlock")))
	   (prompt "Error: ByLayer/ByBlock options are not applicable."))
       (if (= "Model" (getvar 'ctab))
	 (command "_.layer" "_ps" n (substr (apply 'strcat (mapcar '(lambda (x) (strcat "," x)) l)) 2) "")
	 (command "_.vplayer" "_ps" n (substr (apply 'strcat (mapcar '(lambda (x) (strcat "," x)) l)) 2) "_c" ""))
       )
  (*error* "end")
  )

 

Message 8 of 8

MSchille-1994
Collaborator
Collaborator

@ВeekeeCZ you are good.  Thanks so much.

Attitude, not Aptitude, Determines Altitude
0 Likes