Extract the attributes, and written table (help)

[Tharwat]

Maybe this ?

 

(defun c:Test  (/ ss pt n i sn tg lst l c r inc tbl st in wrt nu y)
 ;;    Author : Tharwat Al Shoufi                                ;;
 ;;    Date : 18. November. 2014                                ;;
 ;;    Write a special kind of attributes to AutoCAD table        ;;
 (if
   (and
     (if (tblsearch "STYLE" "SIMPLEX")
       t
       (progn
         (alert "Text Style < SIMPLEX > is not found in Drawing !")
         nil
       )
     )
     (princ "\n Select named blocks < TitleBar > :")
     (setq ss (ssget '((0 . "INSERT") (66 . 1) (2 . "TitleBar"))))
     (setq
       *hgt* (cond ((getdist (strcat "\n Specify Text Height < "
                                     (if *hgt*
                                       (rtos *hgt* 2 2)
                                       (rtos (setq *hgt* 1.0) 2 2)
                                     )
                                     " > :"
                             )
                    )
                   )
                   (*hgt*)
             )
     )
     (setq pt (getpoint "\n Specify Base Point of Table :"))
   )
    (progn
      (setq n -1)
      (repeat (setq i (sslength ss))
        (setq sn (ssname ss (setq i (1- i))))
        (mapcar
          '(lambda (x)
             (if (or (eq (setq tg (strcase (vla-get-tagstring x)))
                         "DRAWINGNO."
                     )
                     (eq tg "PARTNAME")
                     (eq tg "MATERIAL")
                     (eq tg "QTY")
                 )
               (setq lst (cons (vla-get-textstring x) lst))
             )
           )
          (vlax-invoke (vlax-ename->vla-object sn) 'getattributes)
        )
        (setq l   (cons lst l)
              lst nil
        )
      )
      (setq l
             (vl-sort
               l
               '(lambda (n i)
                  (<
                    (atoi (substr (setq st (cadr n)) (- (strlen st) 2))
                    )
                    (atoi (substr (setq st (cadr i)) (- (strlen st) 2))
                    )
                  )
                )
             )
      )
      (or acdoc
          (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
      )
      (setq c   5
            r   2
            inc -1
            tbl (vla-addtable
                  (vla-get-modelspace acdoc)
                  (vlax-3d-point (trans pt 1 0))
                  (+ (length l) r)
                  c
                  (* *hgt* 2.5)
                  (* *hgt* 2.5)
                )
      )
      (if (tblsearch "LAYER" "dim")
        (vla-put-layer tbl "dim")
      )
      (mapcar
        '(lambda (h) (vla-setcolumnwidth tbl (setq inc (1+ inc)) h))
        (mapcar '(lambda (x) (* *hgt* x))
                '(5. 10.5 7. 7. 7.)
        )
      )
      (setq inc -1)
      (repeat (+ (length l) r)
        (vla-setrowheight tbl (setq inc (1+ inc)) (* *hgt* 1.2))
      )
      (defun _settext (c st)
        (vla-settext tbl r c st)
        (vla-setcelltextstyle tbl r c "SIMPLEX")
        (vla-SetCellTextHeight tbl r c *hgt*)
        (vla-setcellalignment tbl r c acMiddleCenter)
        (vla-setrowheight tbl r (* *hgt* 1.2))
      )
      (setq r 0)
      (_settext 0 "BOM")
      (setq r 1)
      (mapcar '_settext
              (list 0 1 2 3 4)
              '("NO." "Drawing No." "Part Name" "Material" "Quantity")
      )
      (setq r  2
            c  0
            i  -1
            in -1
      )
      (foreach v l
        (foreach it (append (mapcar 'car l) (mapcar 'cadr l))
          (if (or (eq (substr it (- (strlen it) 3))
                      (substr (cadr v) (- (strlen (cadr v)) 3))
                  )
                  (eq it (car v))
              )
            (setq y (cons it y))
          )
        )
        (if (> (length y) 2)
          (setq wrt (list (strcat "{\\C1;" (cadr v) "}")
                          (strcat "{\\C1;" (car v) "}")
                          (strcat "{\\C1;" (caddr v) "}")
                          (strcat "{\\C1;" (nth 3 v) "}")
                    )
                red t
          )
          (setq wrt (list (cadr v) (car v) (caddr v) (nth 3 v))
                red nil
          )
        )
        (setq y nil
              i (1+ i)
        )
        (if (< i 10)
          (setq nu (strcat "0" (itoa i)))
          (setq nu (itoa i))
        )
        (_settext
          c
          (if red
            (strcat "{\\C1;" nu "}")
            nu
          )
        )
        (foreach txt wrt
          (_settext (setq c (1+ c)) txt)
        )
        (setq c 0
              r (1+ r)
        )
      )
      (princ)
    )
 )
 (princ)
)

Edited November 18, 2014 by Tharwat

[andy_lee]

Maybe this ?

 

Sorry !Master Tharwat, Not this! Thank you for your patience to help me ！

 

I don't need the same drawing number change color at the same time , if 3 or 4 drawing number is the same , Harder to resolve. so I don't need this .

 

After this time you modify, The same PARTNAME can't changed color .

 

Let me think about it. Maybe I need someone help me translate my thoughts.

Please wait a moment . Master Tharwat,Thank you for your patience to help me ！

[Tharwat]

I modified the codes in Post 41 try it and let me know .

[andy_lee]

I modified the codes in Post 41 try it and let me know .

 

Thank you so mush! Master Tharwat, I' m sorry ! I'm still waiting for a friend to help me translate.

 

You can test this document frist.

TEST1.dwg

[Tharwat]

You can test this document frist.

[ATTACH]51647[/ATTACH]

Why you are re-uploading the same file as you have uploaded in your first post ?

[andy_lee]

Why you are re-uploading the same file as you have uploaded in your first post ?

 

NO,is not same, I changed drawing name .

Is like this ,Isn't it

 

No highlight, is that right ?

[Tharwat]

No highlight, is that right ?

 

Which number of rows in that schedule you think it should be highlighted ?

[andy_lee]

Which number of rows in that schedule you think it should be highlighted ?

 

 

13 and 14 , Because, "030" Repeat.

[andy_lee]

That is why I said only check last three digits

[Tharwat]

13 and 14 , Because, "030" Repeat.

 

Try it now , I modified the codes in Post # 41

[Tharwat]

That is why I said only check last three digits

That was for showing the date in sequence and not for coloring if any of them have the same values as you have declared before .

[hanhphuc]

hi Tharwat as usual you are so helpful

Format text by {\\C1 } so simple other than rgb method

 

my understanding OP wants to highlight either 1 of 2 duplicates for specified cell which refer to ONLY the last 3 digit of dwg No: eg: 1-SS706A-030

ie: if 2 are same than just highlight 1 of the cell ,not all cells.

 

i'm not sure whether hitTest function helps? which OP can highlight himself?

[andy_lee]

Try it now , I modified the codes in Post # 41

 

Master Tharwat, Thank you for your patience to help me ！

This is what I want ,very nice!!! beautiful !!!

You should get "Forum Help Award"

 

why you add *hgt* into the Local variables? So, need to input Text Height every time . I remove it ,It seems no err.

[andy_lee]

hi Tharwat as usual you are so helpful

 

hanhphuc ,Thank you for help!

[Tharwat]

hi Tharwat as usual you are so helpful

Format text by {\\C1 } so simple other than rgb method

 

Thank you hanhphuc

 

my understanding OP wants to highlight either 1 of 2 duplicates for specified cell which refer to ONLY the last 3 digit of dwg No: eg: 1-SS706A-030

ie: if 2 are same than just highlight 1 of the cell ,not all cells.

 

i'm not sure whether hitTest function helps? which OP can highlight himself?

 

I guess that's what I did with my last modify to codes .

 

Master Tharwat, Thank you for your patience to help me ！

This is what I want ,very nice!!! beautiful !!!

You should get "Forum Help Award"

 

It is time to say WAW and thanks for the nice words

 

 

why you add *hgt* into the Local variables? So, need to input Text Height every time . I remove it ,It seems no err.

Opps you are right , actually that variable hgt and I replace it with *hgt* to be global by the Replace command in Vlide and I did not notice it localized , so I will erase it from localized variables .

 

Good luck .

 

Tharwat

[andy_lee]

Hi Master Tharawt.

How are you. I need trouble you again

I want add a new attribute values into table. But Failed. Can you help me have a look ? Thanks.

 

Here is my modified

(defun c:Test  (/ ss pt n i sn tg lst l c r inc tbl st in wrt nu y)
 ;;    Author : Tharwat Al Shoufi                                ;;
 ;;    Date : 18. November. 2014                                ;;
 ;;    Write a special kind of attributes to AutoCAD table        ;;
 (if
   (and
     (if (tblsearch "STYLE" "SIMPLEX")
       t
       (progn
         (alert "Text Style < SIMPLEX > is not found in Drawing !")
         nil
       )
     )
     (princ "\n Select named blocks < TitleBar > :")
     (setq ss (ssget '((0 . "INSERT") (66 . 1) (2 . "TitleBar"))))
     (setq
       *hgt* (cond ((getdist (strcat "\n Specify Text Height < "
                                     (if *hgt*
                                       (rtos *hgt* 2 2)
                                       (rtos (setq *hgt* 1.0) 2 2)
                                     )
                                     " > :"
                             )
                    )
                   )
                   (*hgt*)
             )
     )
     (setq pt (getpoint "\n Specify Base Point of Table :"))
   )
    (progn
      (setq n -1)
      (repeat (setq i (sslength ss))
        (setq sn (ssname ss (setq i (1- i))))
        (mapcar
          '(lambda (x)
             (if (or (eq (setq tg (strcase (vla-get-tagstring x)))
                         "DRAWINGNO."
                     )
                     (eq tg "PARTNAME")
                     (eq tg "MATERIAL")
                     (eq tg "QTY")
	    [color="red"] (eq tg "DRDATA")[/color]
                 )
               (setq lst (cons (vla-get-textstring x) lst))
             )
           )
          (vlax-invoke (vlax-ename->vla-object sn) 'getattributes)
        )
        (setq l   (cons lst l)
              lst nil
        )
      )
      (setq l
             (vl-sort
               l
               '(lambda (n i)
                  (<
                    (atoi (substr (setq st (cadr n)) (- (strlen st) 2))
                    )
                    (atoi (substr (setq st (cadr i)) (- (strlen st) 2))
                    )
                  )
                )
             )
      )
      (or acdoc
          (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
      )
      (setq c   [color="red"]6[/color]
            r   2
            inc -1
            tbl (vla-addtable
                  (vla-get-modelspace acdoc)
                  (vlax-3d-point (trans pt 1 0))
                  (+ (length l) r)
                  c
                  (* *hgt* 2.5)
                  (* *hgt* 2.5)
                )
      )
      (if (tblsearch "LAYER" "dim")
        (vla-put-layer tbl "dim")
      )
      (mapcar
        '(lambda (h) (vla-setcolumnwidth tbl (setq inc (1+ inc)) h))
        (mapcar '(lambda (x) (* *hgt* x))
                '(5. 10.5 7. 7. 7. [color="red"]7.[/color])
        )
      )
      (setq inc -1)
      (repeat (+ (length l) r)
        (vla-setrowheight tbl (setq inc (1+ inc)) (* *hgt* 1.2))
      )
      (defun _settext (c st)
        (vla-settext tbl r c st)
        (vla-setcelltextstyle tbl r c "SIMPLEX")
        (vla-SetCellTextHeight tbl r c *hgt*)
        (vla-setcellalignment tbl r c acMiddleCenter)
        (vla-setrowheight tbl r (* *hgt* 1.2))
      )
      (setq r 0)
      (_settext 0 "BOM")
      (setq r 1)
      (mapcar '_settext
              (list 0 1 2 3 4 [color="red"]5[/color])
              '("NO." "Drawing No." "Part Name" "Material" "Quantity" [color="red"]"Date"[/color])
      )
      (setq r  2
            c  0
            i  -1
            in -1
      )
      (foreach v l
        (foreach it (append (mapcar 'car l) (mapcar 'cadr l))
          (if (or (eq (substr it (- (strlen it) 3))
                      (substr (cadr v) (- (strlen (cadr v)) 3))
                  )
                  (eq it (car v))
              )
            (setq y (cons it y))
          )
        )
        (if (> (length y) 2)
          (setq wrt (list (strcat "{\\C1;" (cadr v) "}")
                          (strcat "{\\C1;" (car v) "}")
                          (strcat "{\\C1;" (caddr v) "}")
                          (strcat "{\\C1;" (nth 3 v) "}")
                    )
                red t
          )
          (setq wrt (list (cadr v) (car v) (caddr v) (nth 3 v))
                red nil
          )
        )
        (setq y nil
              i (1+ i)
        )
        (if (< i 10)
          (setq nu (strcat "0" (itoa i)))
          (setq nu (itoa i))
        )
        (_settext
          c
          (if red
            (strcat "{\\C1;" nu "}")
            nu
          )
        )
        (foreach txt wrt
          (_settext (setq c (1+ c)) txt)
        )
        (setq c 0
              r (1+ r)
        )
      )
      (princ)
    )
 )
 (princ)
)

[Tharwat]

Hi Andy , Happy to hear from you again

 

I am sorry I did not reply to your PM because I was busy this morning and after seeing your request here , I decided to reply to your request here .

 

So, try this modification and let me know .

 

(defun c:Test (/ ss pt n i sn tg lst l c r inc tbl st in wrt nu y)
 ;;------------------------------------------------------------;;
 ;;    Author : Tharwat Al Shoufi				;;
 ;;    Date : 05. may. 2015					;;
 ;;    Write a special kind of attributes to AutoCAD table	;;
 ;;------------------------------------------------------------;;
 (if
   (and
     (if (tblsearch "STYLE" "SIMPLEX")
       t
       (progn
         (alert "Text Style < SIMPLEX > is not found in Drawing !")
         nil
       )
     )
     (princ "\n Select named blocks < TitleBar > :")
     (setq ss (ssget '((0 . "INSERT") (66 . 1) (2 . "TitleBar"))))
     (setq
       *hgt* (cond ((getdist (strcat "\n Specify Text Height < "
                                     (if *hgt*
                                       (rtos *hgt* 2 2)
                                       (rtos (setq *hgt* 1.0) 2 2)
                                     )
                                     " > :"
                             )
                    )
                   )
                   (*hgt*)
             )
     )
     (setq pt (getpoint "\n Specify Base Point of Table :"))
   )
    (progn
      (setq n -1)
      (repeat (setq i (sslength ss))
        (setq sn (ssname ss (setq i (1- i))))
        (mapcar
          '(lambda (x)
             (if (or (eq (setq tg (strcase (vla-get-tagstring x)))
                         "DRAWINGNO."
                     )
                     (eq tg "PARTNAME")
                     (eq tg "MATERIAL")
                     (eq tg "QTY")
                     (eq tg "DRDATA")
                 )
               (setq lst (cons (vla-get-textstring x) lst))
             )
           )
          (vlax-invoke (vlax-ename->vla-object sn) 'getattributes)
        )
        (setq l   (cons lst l)
              lst nil
        )
      )
      (setq l
             (vl-sort
               l
               '(lambda (n i)
                  (<
                    (atoi (substr (setq st (cadr n)) (- (strlen st) 2))
                    )
                    (atoi (substr (setq st (cadr i)) (- (strlen st) 2))
                    )
                  )
                )
             )
      )
      (or acdoc
          (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
      )
      (setq c   6
            r   2
            inc -1
            tbl (vla-addtable
                  (vla-get-modelspace acdoc)
                  (vlax-3d-point (trans pt 1 0))
                  (+ (length l) r)
                  c
                  (* *hgt* 2.5)
                  (* *hgt* 2.5)
                )
      )
      (if (tblsearch "LAYER" "dim")
        (vla-put-layer tbl "dim")
      )
      (mapcar
        '(lambda (h) (vla-setcolumnwidth tbl (setq inc (1+ inc)) h))
        (mapcar '(lambda (x) (* *hgt* x))
                '(5. 12.5 7. 7. 7. 10.)
        )
      )
      (setq inc -1)
      (repeat (+ (length l) r)
        (vla-setrowheight tbl (setq inc (1+ inc)) (* *hgt* 1.2))
      )
      (defun _settext (c st)
        (vla-settext tbl r c st)
        (vla-setcelltextstyle tbl r c "SIMPLEX")
        (vla-SetCellTextHeight tbl r c *hgt*)
        (vla-setcellalignment tbl r c acMiddleCenter)
        (vla-setrowheight tbl r (* *hgt* 1.2))
      )
      (setq r 0)
      (_settext 0 "BOM")
      (setq r 1)
      (mapcar '_settext
              (list 0 1 2 3 4 5)
              '("NO." "Drawing No." "Part Name" "Material" "Quantity"
                "Date"
               )
      )
      (setq r  2
            c  0
            i  -1
            in -1
      )
      (foreach v l
        (foreach it (append (mapcar 'car l) (mapcar 'cadr l))
          (if (or (eq (substr it (- (strlen it) 3))
                      (substr (cadr v) (- (strlen (cadr v)) 3))
                  )
                  (eq it (car v))
              )
            (setq y (cons it y))
          )
        )
        (if (> (length y) 2)
          (setq wrt (list (strcat "{\\C1;" (cadr v) "}")
                          (strcat "{\\C1;" (car v) "}")
                          (strcat "{\\C1;" (caddr v) "}")
                          (strcat "{\\C1;" (nth 3 v) "}")
                          (strcat "{\\C1;" (nth 4 v) "}")
                    )
                red t
          )
          (setq wrt (list (cadr v) (car v) (caddr v) (nth 3 v) (nth 4 v))
                red nil
          )
        )
        (setq y nil
              i (1+ i)
        )
        (if (< i 10)
          (setq nu (strcat "0" (itoa i)))
          (setq nu (itoa i))
        )
        (_settext
          c
          (if red
            (strcat "{\\C1;" nu "}")
            nu
          )
        )
        (foreach txt wrt
          (_settext (setq c (1+ c)) txt)
        )
        (setq c 0
              r (1+ r)
        )
      )
      (princ)
    )
 )
 (princ)
)(vl-load-com)

[andy_lee]

Hi Andy , Happy to hear from you again

 

I am sorry I did not reply to your PM because I was busy this morning and after seeing your request here , I decided to reply to your request here .

 

So, try this modification and let me know .

 

Hi Master Tharawt.

Don't say sorry . You are my benefactor

Ok now , I saw the change

add

(strcat "{\\C1;" (nth 4 v) "}")

and

(setq wrt (list (cadr v) (car v) (caddr v) (nth 3 v) (nth 4 v))

 

if I need add more attribute. so do it like this ?

(strcat "{\\C1;" (nth 5 v) "}")
(strcat "{\\C1;" (nth 6 v) "}")
......
......
(setq wrt (list (cadr v) (car v) (caddr v) (nth 3 v) (nth 4 v) (nth 5 v) (nth 6 v))

[Tharwat]

Yeah , and don't forget about the column quantity and the head title besides that the tag name as well .

[andy_lee]

Yeah , and don't forget about the column quantity and the head title besides that the tag name as well .

 

I know! Thanks