Change Color

[whosa]

Hi,

 

I need a little help with the lisp attached to this post. Is it possible to change the color to yellow when the result is different from 0.00?

 

Many thanks

 

(defun C:rin2 ( / e o p d )
	(setvar 'errno 0)
	(and
		vlax-get-acad-object
		(while (/= 52 (getvar 'errno))
			(setq e (car (nentsel "\nSelect text to fill: ")))
			(cond 
				((= 7 (getvar 'errno))
					(princ "\nMissed, try again.") (setvar 'errno 0)
				)
				((and e (not (vlax-property-available-p (setq o (vlax-ename->vla-object e)) 'TextString)))
					(princ "\nThis is not a text object.") (setq e nil)
				)
				((and o (eq (vla-get-Lock (vla-item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-Layer o))) :vlax-true))
					(princ "\nThis object is on a locked layer.") (setq e nil)
				)
				(e
					(if 
						(and 
							(setq p (getpoint "\nSpecify first point: ")) 
							(cadr (setq p (cons p (list (getpoint "\nSpecify second point: " p)))))
							(setq d (rtos (abs (/ (apply '- (mapcar 'last (mapcar '(lambda (x) (trans x 1 0)) p))) 1000.)) 2 2))
						)
						(cond
							( (= "ATTDEF" (cdr (assoc 0 (entget e)))) (vla-put-TagString o d) )
							( T (vla-put-TextString o d) )
						)
					)
					(setvar 'errno 52)
				)
				(T nil)
			)
		)
	)
	(princ)
);| defun |; (or vlax-get-acad-object (vl-load-com)) (princ)

 

[mhupp]

update the Cond

 

(cond
  ((and (= "ATTDEF" (cdr (assoc 0 (entget e)))) (/= d "0.00"))
        (vla-put-TagString o d)
        (vla-put-Color o 2)
  )
  ((= "ATTDEF" (cdr (assoc 0 (entget e))))
      (vla-put-TagString o d)
  )
  ((/= d "0.00")
       (vla-put-TextString o d)
       (vla-put-Color o 2)
  )
  (t
    (vla-put-TagString o d)
  )
)

 

[BIGAL]

mhupp its possibly better to leave d as a number can use equal with fuzz factor or = for most cases.

(rtos 1.2 2 2)
"1.2"

(rtos 0.0 2 2 )

"0"

(rtos 0.0000000001 2 2 )
"0"

[mhupp]

Your right if you going to do a job do it right the fist time.

 

(defun C:rin2 (/ e o p d)
  (vl-load-com)
  (setvar 'errno 0)
  (and
    vlax-get-acad-object
    (while (/= 52 (getvar 'errno))
      (setq e (car (nentsel "\nSelect text to fill: ")))
      (cond
        ((= 7 (getvar 'errno))
            (princ "\nMissed, try again.") (setvar 'errno 0)
        )
        ((and e (not (vlax-property-available-p (setq o (vlax-ename->vla-object e)) 'TextString)))
              (princ "\nThis is not a text object.") (setq e nil)
        )
        ((and o (eq (vla-get-Lock (vla-item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-Layer o))) :vlax-true))
              (princ "\nThis object is on a locked layer.") (setq e nil)
        )
        (e
          (if
            (and
              (setq p (getpoint "\nSpecify first point: "))
              (setq p (cons p (list (getpoint "\nSpecify second point: " p))))
              (setq d (abs (/ (apply '- (mapcar 'last (mapcar '(lambda (x) (trans x 1 0)) p))) 1000.0)))
            )
            (cond
              ((and (= "ATTDEF" (cdr (assoc 0 (entget e)))) (<= d 0.009))
                (vla-put-TagString o (rtos d 2 2))
              )
              ((= "ATTDEF" (cdr (assoc 0 (entget e))))
                (vla-put-TagString o (rtos d 2 2))
                (vla-put-Color o 2)
              )
              ((<= d 0.009)
                (vla-put-TextString o (rtos d 2 2))
              )
              (t
                (vla-put-textstring o (rtos d 2 2))
                (vla-put-Color o 2)
              )
            )
          )
          (setvar 'errno 52)
        )
        (T nil)
      )
    )
  )
  (princ)
)

 

[whosa]

a huge thanks. 

 

Work very well 

 

 

[whosa]

I have a polyline, arc, and ellipse in my block.

 

Is it possible to change the color of all selected elements?

 

 

[mhupp]

I don't see how that is updating.  If an attribute is inside a block it shows up to me as "ATTRIB"

I had to change "ATTDEF" to that and vla-put-Tagstring to vla-put-textstring.

 

 

(defun C:rin2 (/ e o p d)
  (vl-load-com)
  (setvar 'errno 0)
  (and
    vlax-get-acad-object
    (while (/= 52 (getvar 'errno))
      (setq e (car (nentsel "\nSelect text to fill: ")))
      (cond
        ((= 7 (getvar 'errno))
            (princ "\nMissed, try again.") (setvar 'errno 0)
        )
        ((and e (not (vlax-property-available-p (setq o (vlax-ename->vla-object e)) 'TextString)))
              (princ "\nThis is not a text object.") (setq e nil)
        )
        ((and o (eq (vla-get-Lock (vla-item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-Layer o))) :vlax-true))
              (princ "\nThis object is on a locked layer.") (setq e nil)
        )
        (e
          (if
            (and
              (setq p (getpoint "\nSpecify first point: "))
              (setq p (cons p (list (getpoint "\nSpecify second point: " p))))
              (setq d (abs (/ (apply '- (mapcar 'last (mapcar '(lambda (x) (trans x 1 0)) p))) 1000.0)))
            )
            (cond
              ((and (= "ATTRIB" (cdr (assoc 0 (entget e)))) (<= d 0.009))
                (vla-put-TextString o (rtos d 2 2))
              )
              ((= "ATTRIB" (cdr (assoc 0 (entget e))))
                (vla-put-TextString o (rtos d 2 2))
                (vla-put-Color o 2)               
                (if (setq ent (tblobjname "block" (cdr (assoc 2 (entget (cdr (assoc 330 (entget e)))))))) ;get parent block entname
                  (while (setq ent (entnext ent))
                    (setq entlst (cons ent entlst))
                  ) 
                )
                (foreach ent entlst
                  (vla-put-Color (vlax-ename->vla-object ent) 2)
                )
                (vla-Regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports) ; regen to update block
              )
              ((<= d 0.009)
                (vla-put-TextString o (rtos d 2 2))
              )
              (t
                (vla-put-textstring o (rtos d 2 2))
                (vla-put-Color o 2)
              )
            )
          )
          (setvar 'errno 52)
        )
        (T nil)
      )
    )
  )
  (princ)
)

 

Edited March 17, 2022 by mhupp

[whosa]

Thanks, sorry. The lisp work well but I would like to add a feature.

 

I would like to change the color of the text+ the color of the polyline, arc, and ellipse of my standard bubble dimension (it is not block) if it is possible.

 

Something like: select all the element  of the bubble dimention (text + ellipse + etc.) -> rin2 -> if not equal to 0 change evething in yellow. 

 

Right now the lisp allows only text input. 

 

Thanks again

Edited March 17, 2022 by whosa

[mhupp]

That's what I am confused about I don't think your attributes are inside that Block. When attributes are just in model space show up as "ATTDEF". When they are in a block they show up as "ATTRIB". So you need to add those attributes to the block in question and then that lisp will work the way you want.

 

The Block I have attached has the attribute inside.

$C49K3-9Q2227.dxf

[whosa]

Sorry, it was my mistake. Miss Understand.

 

Attached you can find my standard bub dimension. Basically, it is a text inside an ellipse.

 

The lisp makes the text in yellow and works fantastic. I asked if is possible to add a feature. I would like a lisp that changes text (as rin2 does) and ellipse (and everything is selected such arc and circle) in yellow .

TEST.dxf

[mhupp]

Just assumed the blocks only had Attributes. cleaned up the cod a bit no real need to need to test for attributes.

(defun C:rin2 (/ e o p d entlst blkname)
  (vl-load-com)
  (setvar 'errno 0)
  (and
    vlax-get-acad-object
    (while (/= 52 (getvar 'errno))
      (setq e (car (nentsel "\nSelect text to fill: ")))
      (cond
        ((= 7 (getvar 'errno))
            (princ "\nMissed, try again.") (setvar 'errno 0)
        )
        ((and e (not (vlax-property-available-p (setq o (vlax-ename->vla-object e)) 'TextString)))
              (princ "\nThis is not a text object.") (setq e nil)
        )
        ((and o (eq (vla-get-Lock (vla-item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-Layer o))) :vlax-true))
              (princ "\nThis object is on a locked layer.") (setq e nil)
        )
        (e
          (if
            (and
              (setq p (getpoint "\nSpecify first point: "))
              (setq p (cons p (list (getpoint "\nSpecify second point: " p))))
              (setq d (abs (/ (apply '- (mapcar 'last (mapcar '(lambda (x) (trans x 1 0)) p))) 1000.0)))
            )
            (cond
              ((<= d 0.009)
                (vla-put-textstring o (substr (rtos d 2 3) 1 4))
              )
              (t
                (vla-put-textstring o (substr (rtos d 2 3) 1 4))
                (vla-put-Color o 2)
                (if (and (setq blkname (cdr (assoc 2 (entget (cdr (assoc 330 (entget e))))))) (/= blkname "*Model_Space")) ;get parent block entname
                  (progn
                    (setq obj (tblobjname "block" blkname))
                    (while (setq obj (entnext obj))
                      (setq entlst (cons obj entlst))
                    ) 
                    (foreach ent entlst
                      (vla-put-Color (vlax-ename->vla-object ent) 2)
                    )
                  )
                )
              )
            )
            (setvar 'errno 52)
          )
        )
        (T nil)
      )
      (vla-Regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports) ; regen to update block
    )
  )
  (princ)
)

 

[whosa]

Many thanks for this. Work well on test file but not in my case. 

 

My case is: I have several bubble dimensions placed on a DWG. Each bubble dimension is exploded and formed by text + ellipse + arc + small circle. 

 

Your first Lisp attached to this post works fantastic but I can change only the text (value) to yellow according to the condition > 0.00. 

 

I would like to change the text and ellipse + arc + circle or everything I selected before/after type RIN2.

 

Something like:

1. type RIN2

2. select all the elements I want to change (ex. text 1 + ellipse 1 + arc 1 + circle 1)

3. snap 2 heigh values

4:. if the result is > 0.00 the lisp should change the value at text 1 and the color (to yellow) at text 1+  ellipse 1 + arc 1 + circle 1

 

 

16 hours ago, mhupp said:

Your right if you going to do a job do it right the fist time.

 

(defun C:rin2 (/ e o p d)
  (vl-load-com)
  (setvar 'errno 0)
  (and
    vlax-get-acad-object
    (while (/= 52 (getvar 'errno))
      (setq e (car (nentsel "\nSelect text to fill: ")))
      (cond
        ((= 7 (getvar 'errno))
            (princ "\nMissed, try again.") (setvar 'errno 0)
        )
        ((and e (not (vlax-property-available-p (setq o (vlax-ename->vla-object e)) 'TextString)))
              (princ "\nThis is not a text object.") (setq e nil)
        )
        ((and o (eq (vla-get-Lock (vla-item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-Layer o))) :vlax-true))
              (princ "\nThis object is on a locked layer.") (setq e nil)
        )
        (e
          (if
            (and
              (setq p (getpoint "\nSpecify first point: "))
              (setq p (cons p (list (getpoint "\nSpecify second point: " p))))
              (setq d (abs (/ (apply '- (mapcar 'last (mapcar '(lambda (x) (trans x 1 0)) p))) 1000.0)))
            )
            (cond
              ((and (= "ATTDEF" (cdr (assoc 0 (entget e)))) (<= d 0.009))
                (vla-put-TagString o (rtos d 2 2))
              )
              ((= "ATTDEF" (cdr (assoc 0 (entget e))))
                (vla-put-TagString o (rtos d 2 2))
                (vla-put-Color o 2)
              )
              ((<= d 0.009)
                (vla-put-TextString o (rtos d 2 2))
              )
              (t
                (vla-put-textstring o (rtos d 2 2))
                (vla-put-Color o 2)
              )
            )
          )
          (setvar 'errno 52)
        )
        (T nil)
      )
    )
  )
  (princ)
)

 

 

Edited March 17, 2022 by whosa

[mhupp]

I was only using one block for testing, and understand why you have them exploded. But you are going to have to use a block to start with for this lisp to work properly.  Because their isn't an easy way to select the rest of the entity's if they need properties to be changed.

 

If d value is 0.00 only a prompt will display stating that.

If d value is anything other than 0.00 it will explode that block update the text and change all entity's to yellow.

 

See example

https://ibb.co/PwYd4Z7

 

I have also attached the block used in the example.

 

(defun C:rin2 (/ e o p d n x)
  (vl-load-com)
  (setvar 'errno 0)
  (and
    vlax-get-acad-object
    (while (/= 52 (getvar 'errno))
      (setq e (nentselp "\nSelect text to fill: "))
      (cond
        ((= 7 (getvar 'errno))
            (princ "\nMissed, try again.") (setvar 'errno 0)
        )
        ((and e (not (vlax-property-available-p (setq o (vlax-ename->vla-object (car e))) 'TextString)))
          (princ "\nThis is not a text object.") (setq e nil)
        )
        ((and o (eq (vla-get-Lock (vla-item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-Layer o))) :vlax-true))
          (princ "\nThis object is on a locked layer.") (setq e nil)
        )
        (e
          (if
            (and
              (setq p (getpoint "\nSpecify first point: "))
              (setq p (cons p (list (getpoint "\nSpecify second point: " p))))
              (setq d (abs (/ (apply '- (mapcar 'last (mapcar '(lambda (x) (trans x 1 0)) p))) 1000.0)))
            )
            (cond
              ((<= d 0.009)
                (prompt "\nElevation Didn't Change: 0.00 ")
              )                
              ((> d 0.009)
                (if (and (> (length e) 2) (setq n (cdr (assoc 2 (entget (setq x (last (last e))))))))
                  (progn
                    (setq a (vlax-invoke (vlax-ename->vla-object x) 'explode))
                    (foreach ent a
                      (if (eq (vla-get-ObjectName ent) "AcDbText")
                        (progn
                          (vla-put-Color ent 2)
                          (vla-put-textstring ent (substr (rtos d 2 3) 1 4))
                        )
                        (vla-put-Color ent 2)
                      )                        
                    )
                    (entdel x)
                    (prompt (strcat "\nElevation change is " (substr (rtos d 2 3) 1 4)))
                  )
                  (progn
                    (vla-put-textstring o (substr (rtos d 2 3) 1 4))
                    (vla-put-Color o 2)
                    (prompt (strcat "\nElevation change is " (substr (rtos d 2 3) 1 4)))
                  )
                )
              )
            )
            (setvar 'errno 52)
          )
        )
        (T nil)
      )
    )
  )
  (princ)
)

 

TEST.dxf

Edited March 17, 2022 by mhupp
formatting

[whosa]

This works well on blocks.  By the way 90% of the time, I need to deal with exploded bubble dimensions. 

 

I will use your first lisp and that will change the color of the text only and that's it. 

 

Tanks a lot for your time, you was so helpful.  

Edited March 18, 2022 by whosa