Author Topic: Attribute edit program (lisp and dcl) will not work (Read 3601 times)

TJAM51 · « **on:** February 28, 2005, 09:05:12 AM »

The following routine and it's associated dcl file will not work 100%. The layer listing in the dcl will not list any layers in the drawing nor will the attribute move option work. I have listed both routine and dcl below.

LISP

Code: [Select]


;;Attribute editor DCL (ATE)
(defun c:ate ()
  (setq en (nentsel "\nPick an attribute: "))
  (if en
    (progn
      (setq el (entget (car en)))
      (if (= (cdr (assoc 0 el)) "ATTRIB")
        (progn
          (setq dh     (load_dialog "ATE")
                el_out el
                styles (get_table "STYLE")
          )
          (while (and dh (new_dialog "ATE" dh)) (ae_set_up_tiles) (ae_actions) (ae_exits (start_dialog)))
        )
        (prompt "\nNot an attribute!")
      )
    )
    (prompt "\nNothing selected.")
  )
  (princ)
)
(princ "\nAte.lsp loaded, type \"ATE\" to start. ")

(defun get_table (table / tmp ret)
  (setq tmp (tblnext table 't))
  (while tmp
    (setq ret (cons (cdr (assoc 2 tmp)) ret)
          tmp (tblnext table)
    )
  )
  (reverse ret)
)

(defun ae_set_up_tiles ()
  (set_tile "TN" (cdr (assoc 2 el)))
  (set_tile "TXT" (cdr (assoc 1 el)))
  (set_tile "HGT2" (rtos (cdr (assoc 40 el))))
  (set_tile "WDT2" (rtos (cdr (assoc 41 el))))
  (set_tile "ROT2" (angtos (cdr (assoc 50 el))))
  (set_tile "OBQ2" (angtos (cdr (assoc 51 el))))
  (if (assoc 62 el)
    (set_tile "COL2"
              (if (/= (cdr (assoc 62 el)) 0)
                (itoa (cdr (assoc 62 el)))
                "BYLAYER"
              )
    )
    (set_tile "COL2" "BYLAYER")
  )
  (if (= 2 (logand (cdr (assoc 71 el)) 2))
    (set_tile "MRX" "1")
  )
  (if (= 4 (logand (cdr (assoc 71 el)) 4))
    (set_tile "MRY" "1")
  )
  (if (= 1 (logand (cdr (assoc 70 el)) 1))
    (set_tile "INV" "1")
  )
  (start_list "STY")
  (mapcar 'add_list styles)
  (end_list)
  (set_tile "STY" (itoa (- (length styles) (length (member (cdr (assoc 7 el)) styles)))))
)

(defun ae_actions ()
  (action_tile "TXT" "(EL_SUB 1 $value)")
  (action_tile "HGT2" "(EL_SUB 40 (atof $value))")
  (action_tile "WDT2" "(EL_SUB 41 (atof $value))")
  (action_tile "ROT2" "(EL_SUB 50 (angtof $value))")
  (action_tile "OBQ2" "(EL_SUB 51 (angtof $value))")
  (action_tile "COL2" "(COLOR_SET $value)")
  (action_tile "COL1" "(COLOR_SET (ACAD_COLORDLG 0))")
  (action_tile "PNT" "(done_dialog 10)")
  (action_tile "HGT1" "(done_dialog 11)")
  (action_tile "WDT1" "(done_dialog 12)")
  (action_tile "ROT1" "(done_dialog 13)")
  (action_tile "OBQ1" "(done_dialog 14)")
  (action_tile "MRX" "(EL_TOGGLE 71 2 $value)")
  (action_tile "MRY" "(EL_TOGGLE 71 4 $value)")
  (action_tile "INV" "(EL_TOGGLE 70 1 $value)")
  (action_tile "STY" "(EL_STYLE $value)")
)

(defun ae_exits (ex)
  (cond ((= ex 0) (entmod el_out) (entupd (car en)) (setq dh (unload_dialog dh)))
        ((= ex 1) (entmod el) (entupd (car en)) (setq dh (unload_dialog dh)))
        ((= ex 10)
         (setq p1 (getpoint (cdr (assoc 10 el)) "\nNew insert point:"))
         (if p1
           (el_sub 10 p1)
         )
        )
        ((= ex 11)
         (setq p1 (getdist (cdr (assoc 10 el)) "\nNew height: "))
         (if p1
           (progn (el_sub 40 p1) (set_tile "HGT2" (rtos p1)))
         )
        )
        ((= ex 12)
         (setq p1 (getdist "\nNew width factor: "))
         (if p1
           (progn (el_sub 41 p1) (set_tile "WDT2" (rtos p1)))
         )
        )
        ((= ex 13)
         (setq p1 (getangle (cdr (assoc 10 el)) "\nNew rotation: "))
         (if p1
           (progn (el_sub 50 p1) (set_tile "ROT2" (angtos p1)))
         )
        )
        ((= ex 14)
         (setq p1 (getangle (cdr (assoc 10 el)) "\nNew oblique angle: "))
         (if p1
           (progn (el_sub 51 p1) (set_tile "OBQ2" (angtos p1)))
         )
        )
  )
  (if (> ex 9)
    (progn (entmod el) (entupd (car en)))
  )
)

(defun el_sub (grp new) (setq el (subst (cons grp new) (assoc grp el) el)))

(defun el_toggle (grp bit new / cur)
  (setq cur (cdr (assoc grp el))
        cur (if (/= new "1")
              (logand cur (- 255 bit))
              (logior cur bit)
            )
        el  (subst (cons grp cur) (assoc grp el) el)
  )
)

(defun el_style (tmp)
  (setq new (nth (atoi tmp) styles)
        el  (subst (cons 7 new) (assoc 7 el) el)
  )
)

(defun color_set (color)
  (setq color (cond ((= (type color) 'str)
                     (if (or (= color "*") (= (strcase color) "BYLAYER"))
                       0
                       (atoi color)
                     )
                    )
                    ((= (type color) 'int) color)
                    (t nil)
              )
  )
  (if color
    (progn
      (set_tile "COL2" (itoa color))
      (setq el (if (assoc 62 el)
                 (subst (cons 62 color) (assoc 62 el) el)
                 (append el (list (cons 62 color)))
               )
      )
    )
  )
)

DCL FILE

Code: [Select]


ATE : dialog {
  label = "Attribute Editor";
  : row {
    : text { label = "Tag: "; }
    : text { key = "TN"; label="XXXXXXXXXX" ;}
    : toggle {key="INV";label = "Invisible";}
    : toggle {key="MRY";label = "Upside down";}
    : toggle {key="MRX";label = "Backwards";}
  }
  : edit_box {key="TXT";label = "Text"; }
  : boxed_row {
    : popup_list {
      key = "laylist";
      label = "Layer:";
      width = 23;
    }
  }
  : boxed_row {
    : button {key="PNT"; label="< Move point";}
    : popup_list {key="STY"; width=23;}
    : button {key="COL1"; label="Color...";}
    : edit_box {key="COL2"; width=10;}
  }
  : row {
    : boxed_column {
      label = "Text size";
      : row {
        : button {key="HGT1"; label="Height";}
        : edit_box {key="HGT2"; width=5;}
      }
      : row {
        : button {key="WDT1"; label="Width X";}
        : edit_box {key="WDT2"; width=5;}
      }
    }
    : boxed_column {
      label = "Angles";
      : row {
        : button {key="ROT1"; label="Rotation";}
        : edit_box {key="ROT2"; width=5;}
      }
      : row {
        : button {key="OBQ1"; label="Oblique";}
        : edit_box {key="OBQ2"; width=5;}
      }
    }
  }
  ok_cancel;
}

whdjr · « **Reply #1 on:** February 28, 2005, 01:40:58 PM »

I added some lines (in red) that show the changes I made. This should fix your problem.

Quote from: TJAM51

;;Attribute editor DCL (ATE)
(defun c:ate (/ en el dh el_out styles layers)
(setq en (nentsel "\nPick an attribute: "))
(if en
(progn
(setq el (entget (car en)))
(if (= (cdr (assoc 0 el)) "ATTRIB")
   (progn
    (setq   dh (load_dialog "ATE")
      el_out el
      styles (get_table "STYLE")
      layers (get_table "LAYER")
    )
    (while (and dh (new_dialog "ATE" dh))
    (ae_set_up_tiles)
    (ae_actions)
    (ae_exits (start_dialog))
    )
   )
   (prompt "\nNot an attribute!")
)
)
(prompt "\nNothing selected.")
)
(princ)
)
(princ "\nAte.lsp loaded, type \"ATE\" to start. ")

(defun get_table (table / tmp ret)
(setq tmp (tblnext table 't))
(while tmp
(setq ret (cons (cdr (assoc 2 tmp)) ret)
    tmp (tblnext table)
)
)
(reverse ret)
)

(defun ae_set_up_tiles ()
(set_tile "TN" (cdr (assoc 2 el)))
(set_tile "TXT" (cdr (assoc 1 el)))
(set_tile "HGT2" (rtos (cdr (assoc 40 el))))
(set_tile "WDT2" (rtos (cdr (assoc 41 el))))
(set_tile "ROT2" (angtos (cdr (assoc 50 el))))
(set_tile "OBQ2" (angtos (cdr (assoc 51 el))))
(if (assoc 62 el)
(set_tile "COL2"
    (if (/= (cdr (assoc 62 el)) 0)
      (itoa (cdr (assoc 62 el)))
      "BYLAYER"
    )
)
(set_tile "COL2" "BYLAYER")
)
(if (= 2 (logand (cdr (assoc 71 el)) 2))
(set_tile "MRX" "1")
)
(if (= 4 (logand (cdr (assoc 71 el)) 4))
(set_tile "MRY" "1")
)
(if (= 1 (logand (cdr (assoc 70 el)) 1))
(set_tile "INV" "1")
)
(start_list "STY")
(mapcar 'add_list styles)
(end_list)
(set_tile "STY"
    (itoa (- (length styles)
       (length (member (cdr (assoc 7 el)) styles))
       )
    )
)
(start_list "laylist")
(mapcar 'add_list layers)
(end_list)
)

(defun ae_actions ()
(action_tile "TXT" "(EL_SUB 1 $value)")
(action_tile "HGT2" "(EL_SUB 40 (atof $value))")
(action_tile "WDT2" "(EL_SUB 41 (atof $value))")
(action_tile "ROT2" "(EL_SUB 50 (angtof $value))")
(action_tile "OBQ2" "(EL_SUB 51 (angtof $value))")
(action_tile "COL2" "(COLOR_SET $value)")
(action_tile "COL1" "(COLOR_SET (ACAD_COLORDLG 0))")
(action_tile "PNT" "(done_dialog 10)")
(action_tile "HGT1" "(done_dialog 11)")
(action_tile "WDT1" "(done_dialog 12)")
(action_tile "ROT1" "(done_dialog 13)")
(action_tile "OBQ1" "(done_dialog 14)")
(action_tile "MRX" "(EL_TOGGLE 71 2 $value)")
(action_tile "MRY" "(EL_TOGGLE 71 4 $value)")
(action_tile "INV" "(EL_TOGGLE 70 1 $value)")
(action_tile "STY" "(EL_STYLE $value)")
(action_tile "laylist" "(EL_LAYER $value)")
)

(defun ae_exits   (ex)
(cond   ((= ex 0)
    (entmod el_out)
    (entupd (car en))
    (setq dh (unload_dialog dh))
   )
   ((= ex 1)
    (entmod el)
    (entupd (car en))
    (setq dh (unload_dialog dh))
   )
   ((= ex 10)
    (setq p1 (getpoint (cdr (assoc 10 el)) "\nNew insert point:"))
    (if p1
    (el_sub 10 p1)
    )
   )
   ((= ex 11)
    (setq p1 (getdist (cdr (assoc 10 el)) "\nNew height: "))
    (if p1
    (progn (el_sub 40 p1) (set_tile "HGT2" (rtos p1)))
    )
   )
   ((= ex 12)
    (setq p1 (getdist "\nNew width factor: "))
    (if p1
    (progn (el_sub 41 p1) (set_tile "WDT2" (rtos p1)))
    )
   )
   ((= ex 13)
    (setq p1 (getangle (cdr (assoc 10 el)) "\nNew rotation: "))
    (if p1
    (progn (el_sub 50 p1) (set_tile "ROT2" (angtos p1)))
    )
   )
   ((= ex 14)
    (setq p1 (getangle (cdr (assoc 10 el)) "\nNew oblique angle: "))
    (if p1
    (progn (el_sub 51 p1) (set_tile "OBQ2" (angtos p1)))
    )
   )
)
(if (> ex 9)
(progn (entmod el) (entupd (car en)))
)
)

(defun el_sub (grp new)
(setq el (subst (cons grp new) (assoc grp el) el))
)

(defun el_toggle (grp bit new / cur)
(setq   cur (cdr (assoc grp el))
   cur (if   (/= new "1")
    (logand cur (- 255 bit))
    (logior cur bit)
    )
   el (subst (cons grp cur) (assoc grp el) el)
)
)

(defun el_style   (tmp)
(setq   new (nth (atoi tmp) styles)
   el (subst (cons 7 new) (assoc 7 el) el)
)
)

(defun el_layer   (tmp)
(setq   new (nth (atoi tmp) layers)
   el (subst (cons 8 new) (assoc 8 el) el)
)
)

(defun color_set (color)
(setq   color (cond ((= (type color) 'str)
       (if (or (= color "*") (= (strcase color) "BYLAYER"))
       0
       (atoi color)
       )
       )
       ((= (type color) 'int) color)
       (t nil)
    )
)
(if color
(progn
(set_tile "COL2" (itoa color))
(setq el (if (assoc 62 el)
       (subst (cons 62 color) (assoc 62 el) el)
       (append el (list (cons 62 color)))
    )
)
)
)
)

TJAM51 · « **Reply #2 on:** February 28, 2005, 04:10:25 PM »

Thanks for the assist...but when I attempt to use the move function it still does not work. Any ideas?

Thanks

whdjr · « **Reply #3 on:** February 28, 2005, 04:54:17 PM »

TJ,

Unfortunately I can not be of anymore help. Some of the atts move, but some of the atts don't move. I could not find any connection as to why it moves some and not all of them.

Good luck,

kozmos · « **Reply #4 on:** March 01, 2005, 12:01:51 AM »

Becase your code only modify DXF code 10 of the attribute, but the attributes may have justification type such as MiddleTop, MiddleCenter etc. In some justification types, modify DXF code 10 will not take effects, you need to modify DXF code 11 instead.
So in your (done_dialolg 10) codes, please check the attribute justification type or directly use VLISP (use VLA-Object's vla-getboundingbox function to get the move-from-point, and then use vla-move to modify the attribute, then update the parent block.)

whdjr · « **Reply #5 on:** March 01, 2005, 10:35:11 AM »

Excellent catch kosmos.

TJ,

Replace your (= ex 10) condition with the following and everything should work for you.

Code: [Select]

((= ex 10)
	 (if (> (cdr (assoc 72 el)) 0)
	   (and
	     (setq p1 (getpoint (cdr (assoc 11 el)) "\nNew insert point:"))
	     (el_sub 11 p1)
	   )
	   (and
	     (setq p1 (getpoint (cdr (assoc 10 el)) "\nNew insert point:"))
	     (el_sub 10 p1)
	   )
	 )
	)

TJAM51 · « **Reply #6 on:** March 01, 2005, 10:45:35 AM »

FANTASTIC...THANKS GENTLEMEN.....

News:

Author Topic: Attribute edit program (lisp and dcl) will not work (Read 3601 times)

TJAM51

whdjr

TJAM51

whdjr

whdjr

TJAM51