Lisp Edit text dim & change color text dim.

[vnanhvu]

Dear all!

I HAVE EXAMPLE BY IMAGE.

I hope to receive help from you.

Thank you Very Much !

[rlx]

just a little lunch fun , don't use dimension often in my line of work so didn't do much testing and code could use some more error checking and optimization etc. but hey, better than nothing... lunch is over so back to work for me...

; rlx 25 sep 2018 - for vnanhvu

(defun c:dimned ( / dim-ent dim-string dim-color dcl-fn dcl-fp dcl-id new-dim-string new-dim-color )
  (while (setq dim-ent (entsel "\nSelect dimension to edit : "))
    (if (not (= (cdr (assoc 0 (entget (setq dim-ent (car dim-ent))))) "DIMENSION"))
      (princ "\nYou didn't select a dimension")
      (progn
 (or dcl-id (make_dcl))
 (if (and (setq dcl-id (load_dialog dcl-fn)) (new_dialog "dimned" dcl-id))
   (progn
            ; since were in a while loop , reset values
            (setq dim-string (get_dim_string dim-ent) new_dim_string nil
                  dim-color  (get_dim_color  dim-ent) new-dim-color  nil)
     ;set colorimage with color selected dimension
            (set_tile "tp_dim-color" (_FormatColorName dim-color))
            (_SetColorImage "im_dim-color" dim-color)
     ;set editbox with dimension value
            (set_tile "eb_dim_text" (vl-princ-to-string (get_dim_string dim-ent)))
     (action_tile "bt_select_dimension_color" "(Select_Dimension_Color)")
            (action_tile "bt_reset" "(Reset_Dimension)")
            (action_tile "eb_dim_text" "(setq new-dim-string $value)")
     (action_tile "cancel" "(done_dialog 0)")
     (action_tile "accept" "(done_dialog 1)")

     (setq drv (start_dialog))
     (unload_dialog dcl-id)
     (cond
       ((= drv  0))
       ((= drv  1)
               (if new-dim-string (put_dim_string dim-ent new-dim-string))
               (if new-dim-color  (put_dim_color  dim-ent new-dim-color ))
              )
     )
          ); end progn if dialog started
        )
      ); end progn if selected dimension
    )
  )
  (if (and dcl-fn (findfile dcl-fn))(vl-file-delete dcl-fn))
)

(defun make_dcl ()
  (if (and (setq dcl-fn (vl-filename-mktemp ".dcl")) (setq dcl-fp (open dcl-fn "w")))
    (mapcar '(lambda (x)(write-line x dcl-fp))
     '("dimned : dialog {label=\"Dimned (RLX Sep 2018)\";children_fixed_width=true;"
       ":row {:text {label=\"Color\";}"
             ":image_button {color=-2;key=\"im_dim-color\";height=1;width=4;}spacer_0;"
                    ":text_part {width=10;key=\"tp_dim-color\";}"
             ":button {label=\"Select\";key=\"bt_select_dimension_color\";}}"
       ":row {:edit_box {label=\"Value\";key=\"eb_dim_text\";width=20;}"
                    "spacer;:button {label=\"Reset\";key=\"bt_reset\";}}"
              "spacer;:row {alignment=centered; ok_cancel;}}"
      )
    )
  )
  (if dcl-fp (close dcl-fp))(gc)
)


(defun Select_Dimension_Color ( / c )
  (if (setq c (acad_colordlg 7 t))
    (progn
      (setq new-dim-color c)
      (set_tile "tp_dim-color" (_FormatColorName c))
      (_SetColorImage "im_dim-color" c)
    )
  )
)

(defun _SetColorImage ($t c / x y )
  (setq x (dimx_tile $t) y (dimy_tile $t)) (start_image $t) (fill_image 0 0 x y c) (end_image)
)

(defun _FormatColorName ( c )
  (cond ((or (= c 0)(= c "0")) "ByBlock") ((or (= c 1)(= c "1")) "1 (Red)") ((or (= c 2)(= c "2")) "2 (Yellow)")
 ((or (= c 3)(= c "3")) "3 (Green)") ((or (= c 4)(= c "4")) "4 (Cyan)") ((or (= c 5)(= c "5")) "5 (Blue)")
 ((or (= c 6)(= c "6")) "6 (Magenta)") ((or (= c 7)(= c "7")) "7 (Blk/Wht)") ((or (= c 8)(= c "8")) "8 (D.Gray)")
 ((or (= c 9)(= c "9")) "9 (L.Gray)") ((or (= c 256)(= c "256")) "ByLayer")
        (t (vl-princ-to-string c))
  )
)

(defun _CheckColor ( c )
  (cond ((= c 0)(setq c "byblock"))((= c 256)(setq c "bylayer"))((numberp c)(setq c (itoa c)))(t (setq c nil)))
)

; vanilla : (get_dim_color-vanilla (car (entsel "\nSelect object : ")))
(defun get_dim_color-vanilla (e)
  (if (eq (type e) 'ENAME) (setq e (entget e)))
  (if (and (vl-consp e) (assoc 62 e)) (cdr (assoc 62 e)) 256)
)

; vla : (get_dim_color (car (entsel "\nSelect object : ")))
(defun get_dim_color (e)
  (vla-get-color (if (eq (type e) 'VLA-OBJECT) e (vlax-ename->vla-object e)))
)

; vanilla : (put_dim_color-vanilla (car (entsel "\nSelect object : ")))
(defun put_dim_color-vanilla (e col)
  (if (eq (type e) 'ENAME) (setq e (entget e)))
  ;if color code present then swap else append it
  (if (assoc 62 e)
    (entmod (subst (cons 62 col) (assoc 62 e) e))
    (entmod (setq e (append e (list (cons 62 col)))))
  )
)

(defun put_dim_color ( e c )
  (vla-put-color (if (eq (type e) 'VLA-OBJECT) e (vlax-ename->vla-object e)) c)
)

; test (get_dim_string (car (entsel "\nSelect dimension")))
(defun get_dim_string-vanilla ( %dim / dim-dat dim-txt)
  (setq dim-dat (entget %dim) dim-txt (cdr (assoc 1 dim-dat)))
  (if (= dim-txt "")(setq dim-txt (rtos (cdr (assoc 42 dim-dat)) 2 2)) dim-txt))

; test (put_dim_string-vanilla (car (entsel "\nSelect dimension")) (getstring "\nNew text for dimension : "))
(defun put_dim_string-vanilla ( e $str )
  (entmod (subst (cons 1 $str) (assoc 1 (entget e)) (entget e)))
)


; vla-versions :
; (get_dim_string (car (entsel "\nSelect dimension")))
; (get_dim_string (vlax-ename->vla-object (car (entsel "\nSelect dimension"))))
(defun get_dim_string ( %dim / val)
  (or (eq (type %dim) 'VLA-OBJECT)(setq %dim (vlax-ename->vla-object %dim)))
  (if (numberp (setq val (read (vla-get-TextOverride %dim)))) val (vla-get-measurement %dim))
)

; (put_dim_string (vlax-ename->vla-object (car (entsel "\nSelect dimension"))) "dim-object")
; (put_dim_string (car (entsel "\nSelect dimension")) "dim-ename")
(defun put_dim_string ( %dim $s)
  (or (eq (type %dim) 'VLA-OBJECT)(setq %dim (vlax-ename->vla-object %dim)))
  (vla-put-TextOverride %dim $s)
)

(defun Reset_Dimension ()
  (setq new-dim-string "" new-dim-color 256)
  ;set colorimage with color selected dimension
  (set_tile "tp_dim-color" (_FormatColorName new-dim-color))
  (_SetColorImage "im_dim-color" new-dim-color)
  ;set editbox with dimension value
  (set_tile "eb_dim_text" (vl-princ-to-string (vla-get-measurement (vlax-ename->vla-object dim-ent))))
)
; without the dialog stuff :
(defun c:Little-dimmie ( / sel str-obj dim-obj str-val str-col dim-val new-str new-col)
  (while
    (and
      (= (length (setq sel (nentsel "\nPick dimension string : "))) 4)
      (setq str-obj (vlax-ename->vla-object (nth 0 sel)))
      (setq dim-obj (vlax-ename->vla-object (car (nth 3 sel))))
      (setq str-val (vla-get-textstring str-obj))
      (setq str-col (vla-get-color str-obj))
      (setq dim-val (vla-get-measurement dim-obj))
    )
    (princ "\nSelect color for dimenson text : ")
    (if (setq new-col (acad_colordlg str-col t)) (vla-put-color str-obj new-col))
    (setq new-str
           (getstring
             (strcat "\nNew value <" (if (not (eq str-val "")) str-val (vl-princ-to-string dim-val)) "> : " )))
    (if (not (eq new-str "")) (vla-put-TextOverride dim-obj new-str))
    (vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)

  )
)
; (c:dimned)

Edited September 26, 2018 by rlx

[vnanhvu]

Thank you RLX.

Maybe with this lisp is not right with my wishes.
But I thank you for your enthusiasm. 
I hope someone will help me solve this problem !!!

[rlx]

8 hours ago, vnanhvu said:

Thank you RLX.

Maybe with this lisp is not right with my wishes.
But I thank you for your enthusiasm. 
I hope someone will help me solve this problem !!!

 

no problem , hope you find (some)one that better fits your need...

 

Maybe code below better works for you

 

lisp1 = C:Little-dimmie -  select desired color (once) and then in a loop select the dimensions you want to edit.

 

lisp2 = c:S-dim (= show dimension) - manual select dimensions with ssget and every dimension with a text override will turn green

 

 lisp3 = C:R-Dim (= reset dimension) - other way around , select dimensions and all measured values will be restored and color set bylayer

 

cheers

(defun c:Little-dimmie ( / sel default dim-ding dim-obj dim-str dim-val new-col new-str)
  (princ "\nSelect new color for dimension text : ")
  (setq new-col (acad_colordlg 256 t))
  (while (= (length (setq sel (nentsel "\nPick dimension string : "))) 4)
    (setq dim-ding (car (nth 3 sel)) dim-obj (vlax-ename->vla-object dim-ding)
          dim-str (vla-get-textoverride dim-obj) dim-val (vla-get-measurement dim-obj)
          default (vl-princ-to-string (if (/= dim-str "") dim-str dim-val))
          new-str (getstring (strcat "\nNew value <" default "> : ")))
    (if (/= new-str "") (vla-put-TextOverride dim-obj new-str))
    ; even if user didn't enter a value, if textoverride isn't empty change color
    (if (and new-col (/= (vla-get-textoverride dim-obj) ""))
      (vla-put-color (vlax-ename->vla-object (gimmie_dimmie dim-ding)) new-col)
      (vla-put-color (vlax-ename->vla-object (gimmie_dimmie dim-ding)) 256)
    )
  )
  (vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
)

(defun gimmie_dimmie (e / r)
  (and (eq (cdr (assoc 0 (entget e))) "DIMENSION") (setq e (tblobjname "BLOCK" (cdr (assoc 2 (entget e)))))
       (while (setq e (entnext e)) (if (eq (cdr (assoc 0 (entget e))) "MTEXT") (setq r e)))) r)

 

; modify elist
(defun molly (e c v) (entmod (append (vl-remove-if ''((x)(= (car x) c)) e) (list (cons c v)))))
   

; change text color of all selected dimensions which have a textoverride
(defun c:s-dim ( / ss col)
  (setq col 3); color green
  (if (setq ss (ssget '((0 . "DIMENSION"))))
    (mapcar
      '(lambda (x / d s)
         (if (and (setq d (entget x)) (/= (cdr (assoc 1 d)) ""))
           (progn (setq s (entget (gimmie_dimmie x)))(molly s 62 col))))
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    )
  )
  (vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
)

 

; reset dimensions real value / color bylayer
(defun c:r-dim ( / ss)
  (setq col 256) ; bylayer
  (if (setq ss (ssget '((0 . "DIMENSION"))))
    (mapcar
      '(lambda (x / d s)
         (if (and (setq d (entget x)) (/= (cdr (assoc 1 d)) ""))
           (progn
             (vla-put-TextOverride (vlax-ename->vla-object x) "")
             (setq s (entget (gimmie_dimmie x)))(molly s 62 col))))
       (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    )
  )
  (vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
)

 

 

Edited September 27, 2018 by rlx

[vnanhvu]

Dear!

This is what I want.

Thank you very much!!!!