topic Re: Make Styles Current in Visual LISP, AutoLISP and General Customization Forum

Make Styles Current

venturini.anthony — Tue, 29 Aug 2023 14:49:26 GMT

Im looking for a lisp that will make the styles of a selected object current. ive found this but it only works on dimensions. is there a way i can get it to work on leaders, multileaders, mtext, text, etc.

(defun C:matchstyle (/ Res Elist Ent flag Style)
(setq flag 1)
(while flag
(while (null(setq Res (entsel "\nSelect a dimension or leader: "))))
(setq Elist (entget (car Res)))
(if (member (cdr (assoc 0 Elist)) '("DIMENSION" "LEADER"))
(setq flag nil)
);if
);while
(setq Style (cdr (assoc 3 Elist)))
(setvar 'clayer (cdr (assoc 8 Elist)))
(if (wcmatch Style "*$*")
(setq Style (substr Style 1 (- (strlen Style) 2))))
(setvar "nomutt" 1) (setvar "cmdecho" 0)
(command "dimstyle" "r" Style)
(setvar "nomutt" 0) (setvar "cmdecho" 1)
(princ (strcat "\n" style " is now the current DIMENSION style."))
(princ)
)

Re: Make Styles Current

pendean — Tue, 29 Aug 2023 15:24:27 GMT

Leaders follow DIMSTYLE settings: so you just want it to select that dimstyle, you know, like your LISP already does. Are you wanting a different behavior?

What about...
MTEXT: what settings do you want to match there exactly? Or do you just mean the STYLE being used? or overrides (and which ones) ? Width? line Spacing? More? less? CAPS? no Caps? Columns?

TEXT: same, which settings? Style? Justification? More? Less?

Re: Make Styles Current

venturini.anthony — Tue, 29 Aug 2023 15:30:25 GMT

I just want styles matched for text and mtext. And I don't care about it working on leaders I want to match multileader styles.

Re: Make Styles Current

ВeekeeCZ — Tue, 29 Aug 2023 15:37:25 GMT

I have integrated buttons... see if this help. It match the style if something is pre-selected. If not, it goes to the dialog.

; ----
(defun c:DimStyleButton ( / ent obj val)
  
  (if (not (ssget "_I"))
    (progn
      (initcommandversion)
      (command "_.DIMSTYLE"))
    (and
      (setq ent (ssname (ssget "_I") 0))
      (or (= "DIMENSION" (cdr (assoc 0 (entget ent))))
	  (prompt "\nError: Selected object is not dimension!"))
      (setq obj (vlax-ename->vla-object ent))
      (vlax-property-available-p obj 'StyleName T)
      (setq val (vlax-get-property obj 'StyleName))
      (vl-cmdf "_.-DIMSTYLE" "_R" val)
      (princ (strcat "\nCurrent dimstyle: " val))
      (sssetfirst nil nil)))
  (princ)
  )

; ----
(defun c:MleaderStyleButton ( / ent obj val)
  
  (if (not (ssget "_I"))
    (command "_.MLEADERSTYLE")
    (and
      (setq ent (ssname (ssget "_I") 0))
      (or (= "MULTILEADER" (cdr (assoc 0 (entget ent))))
	  (prompt "\nError: Selected object is not multileader!"))
      (setq obj (vlax-ename->vla-object ent))
      (vlax-property-available-p obj 'StyleName T)
      (setq val (vlax-get-property obj 'StyleName))
      (setvar 'CMLEADERSTYLE val)
      (princ (strcat "\nCurrent mleaderstyle: " val))
      (sssetfirst nil nil)))
  (princ)
  )

; ----
(defun c:TextStyleButton ( / ent obj prp typ val)
  
  (if (not (ssget "_I"))
    (progn
      (initdia)
      (command "_.STYLE"))
    (and
      (setq ent (ssname (ssget "_I") 0))
      (setq typ (cdr (assoc 0 (entget ent))))
      (setq prp (cond ((= typ "DIMENSION")	'TextStyle)
		      ((= typ "MULTILEADER")	'TextStyleName)
		      (T 			'StyleName)))
      (setq obj (vlax-ename->vla-object ent))
      (or (vlax-property-available-p obj prp T)
	  (prompt "\nError: Selected wrong entity. The style property isn't available!"))
      (setq val (vlax-get-property obj prp))
      (setvar 'TEXTSTYLE val)
      (princ (strcat "\nCurrent textstyle: " val))
      (sssetfirst nil nil)))
  (princ)
  )

Re: Make Styles Current

ВeekeeCZ — Tue, 29 Aug 2023 15:39:55 GMT

Or this one. Couldn't find it.

Re: Make Styles Current

venturini.anthony — Tue, 29 Aug 2023 16:02:03 GMT

this is almost exactly what i need. it does the job, but is there a way you could have it so all you need to do it type the command and then select the object? id rather have it more automatic and not have to select if im trying to match the multileader style or the text style. could it just know what i selected and run based off that and not the user input of multileader, text, or dimension?

Re: Make Styles Current

Kent1Cooper — Tue, 29 Aug 2023 16:33:44 GMT

@venturini.anthony wrote:

.... is there a way you could have it so all you need to do it type the command and then select the object? id rather have it more automatic and not have to select if im trying to match the multileader style or the text style. could it just know what i selected and run based off that and not the user input of multileader, text, or dimension?

The MM command in MakeMore.lsp [EDIT: attached] does that. It sets the Style [and Layer and certain other properties] of the selected object for Text/Mtext/Dimensions/Multilines/MultiLeaders/Hatch patterns, and a lot of other properties about a lot of other kinds of things, and calls up the appropriate command for you or offers options when there is more than one command that can make the selected object.

Re: Make Styles Current

pendean — Tue, 29 Aug 2023 16:52:06 GMT

@Kent1Cooper Sort of like ADDSELECTED command in AutoCAD but on steroids by defaulting every property to the object as well. Nice.

Re: Make Styles Current

venturini.anthony — Tue, 29 Aug 2023 17:13:51 GMT

i modified the make more command for my needs, but i cant get the dimensions to work. any ideas on why?

(defun c:SetStyles ()
(setq cmde (getvar 'cmdecho)) ; Store original command echo state
(setvar 'cmdecho 0) ; Turn off command echo

(setq ent (car (entsel "\nSelect an object to match styles: ")))

(setq typ (cdr (assoc 0 (entget ent)))) ; Get the type of the selected entity

(cond
((member typ '("LWPOLYLINE" "POLYLINE"))
(setvar 'plinetype (cdr (assoc 6 (entget ent))))
(if (= (getvar 'plinetype) 0)
(setvar 'plinetype 2))
)
((= typ "INSERT")
(setq S1 (cdr (assoc 2 (entget ent))))
(setvar 'insname S1)
)
((= typ "MTEXT")
(setq S1 (cdr (assoc 7 (entget ent))))
(setvar 'textstyle S1)
(setq R1 (cdr (assoc 40 (tblsearch "style" S1))))
(if (/= R1 0)
(setvar 'textsize R1))
)
((= typ "DIMENSION")
(setq dimStyleName (cdr (assoc 3 (entget ent))))
(if (tblsearch "dimstyle" dimStyleName)
(progn
(setvar 'dimstyle dimStyleName)
(setq dimTextSize (cdr (assoc 40 (tblsearch "style" dimStyleName))))
(if (/= dimTextSize 0)
(setvar 'dimtxt dimTextSize))
)
(prompt (strcat "\nDimension style \"" dimStyleName "\" does not exist."))
)
)
((= typ "LEADER")
(setq S1 (cdr (assoc 3 (entget ent))))
(setvar 'cmdecho cmde)
(command "_.dimstyle" "r" S1)
)
((= typ "MULTILEADER")
(setq S1 (cdr (assoc 2 (entget ent))))
(setvar 'cmdecho 1)
(setvar 'cmleaderstyle (vla-get-Stylename (vlax-ename->vla-object ent)))
(prompt (strcat "\nSet current MultiLeader Style to \"" S1 "\".\n"))
(command "_.mleader")
)
((= typ "TEXT")
(setq S1 (cdr (assoc 7 (entget ent))))
(setvar 'textstyle S1)
(setq R1 (cdr (assoc 40 (tblsearch "style" S1))))
(setq R2 (cdr (assoc 41 (tblsearch "style" S1))))
(setvar 'textsize R1)
(setvar 'hpspace R2)
(setvar 'hpdouble (cdr (assoc 1070 (cadr (assoc -3 (entget ent '("ACAD")))))))
)
((= typ "HATCH")
(setq S1 (cdr (assoc 2 (entget ent))))
(setvar 'hpname S1)
(setq R1 (cdr (assoc 41 (tblsearch "style" S1))))
(setq R2 (cdr (assoc 52 (entget ent))))
(setvar 'hpscale R1)
(setvar 'hpang R2)
(setvar 'hpassoc (cdr (assoc 97 (entget ent))))
)
((= typ "MINSERT")
(setq S1 (cdr (assoc 2 (entget ent))))
(setvar 'insname S1)
)
((= typ "MTEXT")
(setq S1 (cdr (assoc 7 (entget ent))))
(setq S2 (cdr (assoc 50 (entget ent))))
(setvar 'textstyle S1)
(setvar 'textsize S2)
(setvar 'tspacetype (cdr (assoc 73 (entget ent))))
(setvar 'tspacefac (cdr (assoc 44 (entget ent))))
(setvar 'cmdecho cmde)
(command "_.mtext" "r" S1)
)
(t
(prompt "\nSelected object type is not supported for style matching.")
)
)

(setvar 'cmdecho cmde) ; Restore original command echo state
(princ)
)

(princ)

Re: Make Styles Current

Kent1Cooper — Tue, 29 Aug 2023 17:26:05 GMT

@pendean wrote:

.... Sort of like ADDSELECTED command in AutoCAD ....

Yes, though it predates ADDSELECTED, and is far more sophisticated. The best example of that is what happens when you select a LWPolyline. ADDSELECTED just sets the Layer and starts a basic PLINE command, regardless. But MM recognizes that there are lots of commands that result in LWPolylines, and offers them to choose from. If the selected one has certain recognizable characteristics [it recognizes those made with RECTANG, POLYGON, DONUT, REVCLOUD if not since altered], it offers the command that is likely to have been what they were drawn with, as a default. And if the selected one has global width, it uses that [ADDSELECTED just uses the current width setting].

I continue to tweak it occasionally, most recently to add MultiLeaders [I'm still pondering including the option of ML;EADEREDIT in case what you want to Make More of is additional Leader(s) on the selected MLeader, not another new one]. Also thinking about other things that didn't exist back when it was first written, such as ARRAY objects from Associative use of ARRAY, Dynamic Blocks, etc.

Re: Make Styles Current

Kent1Cooper — Tue, 29 Aug 2023 17:32:38 GMT

@venturini.anthony wrote:

i modified the make more command for my needs, but i cant get the dimensions to work. any ideas on why?

....

(setvar 'dimstyle dimStyleName)
....

For whatever inexplicable reason, DIMSTYLE is a Read-Only System Variable. You can't set it with (setvar), but must use the DIMSTYLE command and its Restore option [that's what MM does].

Re: Make Styles Current

venturini.anthony — Wed, 30 Aug 2023 17:08:27 GMT

i was able to get it to work how i need. but as soon as you fix one problem, you run into another.

how would i add the ability to make the selected objects layer and color current as well?

(defun c:MCS () (setq cmde (getvar 'cmdecho)) ; Store original command echo state (setvar 'cmdecho 0) ; Turn off command echo (setq ent (car (entsel "\nSelect an Object to Match Current Styles: "))) (setq typ (cdr (assoc 0 (entget ent)))) ; Get the type of the selected entity (cond ((member typ '("LWPOLYLINE" "POLYLINE")) (setvar 'plinetype (cdr (assoc 6 (entget ent)))) (if (= (getvar 'plinetype) 0) (setvar 'plinetype 2)) ) ((= typ "INSERT") (setq S1 (cdr (assoc 2 (entget ent)))) (setvar 'insname S1) ) ((= typ "MTEXT") (setq S1 (cdr (assoc 7 (entget ent)))) (setvar 'textstyle S1) (setq R1 (cdr (assoc 40 (tblsearch "style" S1)))) (if (/= R1 0) (setvar 'textsize R1)) ) ((= typ "DIMENSION") (setq S1 (cdr (assoc 3 (entget ent)))) (setvar 'cmdecho cmde) (command "_.dimstyle" "r" S1) ) ; ((= typ "LEADER") (setq S1 (cdr (assoc 3 (entget ent)))) (setvar 'cmdecho cmde) (command "_.dimstyle" "r" S1) ) ((= typ "MULTILEADER") (setq S1 (cdr (assoc 2 (entget ent)))) (setvar 'cmdecho 1) (setvar 'cmleaderstyle (vla-get-Stylename (vlax-ename->vla-object ent))) (prompt (strcat "\nSet current MultiLeader Style to \"" S1 "\".\n")) (command "_.mleader") ) ((= typ "TEXT") (setq S1 (cdr (assoc 7 (entget ent)))) (setvar 'textstyle S1) (setq R1 (cdr (assoc 40 (tblsearch "style" S1)))) (setq R2 (cdr (assoc 41 (tblsearch "style" S1)))) (setvar 'textsize R1) (setvar 'hpspace R2) (setvar 'hpdouble (cdr (assoc 1070 (cadr (assoc -3 (entget ent '("ACAD"))))))) ) ((= typ "HATCH") (setq S1 (cdr (assoc 2 (entget ent)))) (setvar 'hpname S1) (setq R1 (cdr (assoc 41 (tblsearch "style" S1)))) (setq R2 (cdr (assoc 52 (entget ent)))) (setvar 'hpscale R1) (setvar 'hpang R2) (setvar 'hpassoc (cdr (assoc 97 (entget ent)))) ) ((= typ "MINSERT") (setq S1 (cdr (assoc 2 (entget ent)))) (setvar 'insname S1) ) ((= typ "MTEXT") (setq S1 (cdr (assoc 7 (entget ent)))) (setq S2 (cdr (assoc 50 (entget ent)))) (setvar 'textstyle S1) (setvar 'textsize S2) (setvar 'tspacetype (cdr (assoc 73 (entget ent)))) (setvar 'tspacefac (cdr (assoc 44 (entget ent)))) (setvar 'cmdecho cmde) (command "_.mtext" "r" S1) ) (t (prompt "\nSelected object type is not supported for style matching.") ) ) (setvar 'cmdecho cmde) ; Restore original command echo state (princ) ) (princ)

Re: Make Styles Current

Kent1Cooper — Wed, 30 Aug 2023 17:13:53 GMT

@venturini.anthony wrote:

....

how would i add the ability to make the selected objects layer and color current as well?

[You could just use MM, which does those, along with linetype, linetype scale, lineweight and thickness where applicable. Or you could study how MM does them, and incorporate that into your reduced version.]