color of dimensions in a block-need modification in lisp code

[Anonymous]

Dear Programmers,

I got a lisp code that can change selected dimensions to required colour. I request you to change to make this code. The lisp code should change the dimensions inside all selected blocks to required colour.

(defun c:CDIM (/ ss)
(if (and (setq *clr* (acad_colordlg
(cond (*clr*)
(t (setq *clr* 256))
)
)
)
(princ "\n Select Dimension to change their color :")
(setq ss (ssget "_:L" '((0 . "*DIMENSION"))))
)
((lambda (x / sn)
(while (setq sn (ssname ss (setq x (1+ x))))
(if (vl-remove-if-not
'(lambda (o) (and (eq (car o) 100) (wcmatch (cdr o) "AcDbAlignedDimension,AcDbRotatedDimension")))
(entget sn)
)
(mapcar '(lambda (e)
(vla-put-textcolor e *clr*)
(vla-put-extensionlinecolor e *clr*)
(vla-put-DimensionLineColor e *clr*)
)
(list (vlax-ename->vla-object sn))
)
)
)
)
-1
)
)
(princ)
)
(vl-load-com)

[_gile]

Hi,

You can try this:

(defun c:ColorDimInBlock (/ *error* col ss i)
  (vl-load-com)
  (or *acad* (setq *acad* (vlax-get-acad-object)))
  (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))
  (or *blocks* (setq *blocks* (vla-get-Blocks *acdoc*)))

  (defun *error* (msg)
    (and msg
         (/= (strcase msg) "FUNCTION CANCELLED")
         (princ (strcat "\nError: " msg))
    )
    (vla-EndUndoMark *acdoc*)
    (princ)
  )

  (if
    (and
      (setq col (acad_colordlg 256))
      (ssget '((0 . "INSERT")))
    )
     (progn
       (vlax-for br (setq ss (vla-get-ActiveSelectionSet *acdoc*))
         (or (member (vla-get-Name br) lst)
             (setq lst (cons (vla-get-Name br) lst))
         )
       )
       (vla-Delete ss)
       (foreach n lst
         (vlax-for obj (vla-Item *blocks* n)
           (if (member (vla-get-ObjectName obj) '("AcDbAlignedDimension" "AcDbRotatedDimension"))
             (vla-put-Color obj col)
           )
         )
       )
       (vla-regen *acdoc* acAllViewports)
     )
  )
  (*error* nil)
)

[Anonymous]

Dear Sir,

Thank you, Sir.  The code is good. But the given code is applying the colors for all dimensions in all blocks in cad file. It should apply for only selected blocks. and also it is not applying colors for radial dimensions, angler dimensions and leaders. Requesting you to do this favour for me. Thank you in advance Sir.

[_gile]

---

@Anonymous  a écrit :

Dear Sir,

Thank you, Sir.  The code is good. But the given code is applying the colors for all dimensions in all blocks in cad file. It should apply for only selected blocks.

---

You can not edit the entities of a block reference. You can only edit entities in the block definition and these changes will be reflected in all inserted references to that block definition. This is the way the AutoCAD blocks work.

---

@Anonymous  a écrit :
and also it is not applying colors for radial dimensions, angler dimensions and leaders. Requesting you to do this favour for me. Thank you in advance Sir.

---

The code I posted upper was inspired by the one you provided which only deal with aligned and rotated dimensions.

The following one will work with any kind of dimension and leaders as decribed upper (editing block definitions).

(defun c:ColorDimInBlock (/ *error* col ss i)
  (vl-load-com)
  (or *acad* (setq *acad* (vlax-get-acad-object)))
  (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))
  (or *blocks* (setq *blocks* (vla-get-Blocks *acdoc*)))

  (defun *error* (msg)
    (and msg
         (/= (strcase msg) "FUNCTION CANCELLED")
         (princ (strcat "\nError: " msg))
    )
    (vla-EndUndoMark *acdoc*)
    (princ)
  )

  (if
    (and
      (setq col (acad_colordlg 256))
      (ssget '((0 . "INSERT")))
    )
     (progn
       (vlax-for br (setq ss (vla-get-ActiveSelectionSet *acdoc*))
         (or (member (vla-get-Name br) lst)
             (setq lst (cons (vla-get-Name br) lst))
         )
       )
       (vla-Delete ss)
       (foreach n lst
         (vlax-for obj (vla-Item *blocks* n)
           (if (wcmatch (vla-get-ObjectName obj) "AcDb*Dimension,AcDb*Leader")
             (vla-put-Color obj col)
           )
         )
       )
       (vla-regen *acdoc* acAllViewports)
     )
  )
  (*error* nil)
)

[Anonymous]

Dear Sir,

Thank you for your hard efforts. I am getting the same problem and attached the sample file for your reference.

[_gile]

If I do not misunderstand, a way to do what you want should be dealing with layers.

You could put the color of all dimensions and leaders in the block definition to ByBlock and the other entities on other colors (or Bylayer) so that changing the color of a block reference will only affect the dimensions.

[dbhunia · Accepted solution]

Hi,

Modify .......

This line "(defun c:ColorDimInBlock (/ *error* col ss i)" into "(defun c:ColorDimInBlock (/ *error* col ss i lst)" then try it may resolve your problem........

[_gile]

Right @dbhunia, my mistake, I forgot to localize the variable.

[Anonymous]

Great Sir, Working Super.

[Anonymous]

Dear Sir,

I don't know why It's not working for nested blocks. Please see attachment.

[dbhunia]

Hi

Try this.....

[Anonymous]

Dear Sir,

Thank you for your valuable input. But it is working for single nested block only. If the selected master block has so many nested blocks inside, then the lisp code shall change all blocks dimensions at single click instead of asking for multiple clicks for each nested block.

The code is asking for every single click for color change in masterblock. Thank you in advance Sir.

[dbhunia]

Hi

Try this.....

[Anonymous]

I am thinking that, I am bothering you too much for my requirement. I don't know whether to mention so many times regarding this post.

I have applied this code to attached dwg, but it's not effecting to some nested blocks in master block. That I have highligted in a cloud mark. Can you pleas have a look on attached dwg and image.

Sorry for disturbing you too many times.