Extract the attributes, and written table (help)

[Tharwat]

Try this and let me know how you would get on with it .

 

(defun c:Test (/ ss hgt pt n i sn tg lst l c r inc tbl st dups pns wrt nu)
 ;;    Author : Tharwat Al Shoufi                        ;;
 ;;    Date : 15. 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 hgt *hgt*
            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 1)
      (mapcar '_settext
              (list 0 1 2 3 4)
              '("NO." "Drawing No." "Part Name" "Material" "Quantity")
      )
      (setq r 2
            c 0
            i -1
      )
      (foreach v l
        (if (or (member (cadr v) dups)
                (member (strcase (car v)) pns)
            )
          (setq wrt (list (strcat "{\\C1;" (cadr v) "}")
                          (strcat "{\\C1;" (car v) "}")
                          (strcat "{\\C1;" (caddr v) "}")
                          (strcat "{\\C1;" (nth 3 v) "}")
                    )
                red t
          )
          (setq dups (cons (cadr v) dups)
                pns  (cons (strcase (car v)) pns)
                wrt  (list (cadr v) (car v) (caddr v) (nth 3 v))
                red  nil
          )
        )
        (setq 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 16, 2014 by Tharwat

[andy_lee]

Try this and let me know how you would get on with it .

 

Thanks very much !Tharwat. You are my benefactor .

 

Very nice! beautiful !

There is a little insufficient

1. I need the table layer is "dim"

2. and same name(PARTNAME, DRAWING NO) exists,but no pot-up tips, why?

[Tharwat]

Thanks very much !Tharwat. You are my benefactor .

 

Very nice! beautiful !

 

You are welcome

 

2. and same name(PARTNAME, DRAWING NO) exists,but no pot-up tips, why?

 

I did not get it well , can you explain it in more details or with an image if that is easy for you ?

[andy_lee]

You are welcome

 

I did not get it well , can you explain it in more details or with an image if that is easy for you ?

 

 

Same name, but without prompting

 

Maybe duplicate names, can use red font display .

[Tharwat]

Lots of changes considered in the above modified lisp routine , so try it and let me know .

 

CODES UPDATED ABOVE.

[andy_lee]

Lots of changes considered in the above modified lisp routine , so try it and let me know .

 

CODES UPDATED ABOVE.

 

Master Tharwat, I appriciate your help！ Thank you for your effort.

Near perfect!

DRAWING NO.duplicate Can identify .But PARTNAME duplicate can't identify.

[Tharwat]

updated again.

[andy_lee]

updated again.

 

 

I hope only check last three digits , can do ?

[Tharwat]

 

I hope only check last three digits , can do ?

 

Really ? what does the routine do then ?

[andy_lee]

Really ? what does the routine do then ?

 

Master Tharwat, the routine is very difficult to do it ?

Previous, must "DRAWING NO " is exactly the same , can check out , But two DRAWING NO is 1-SS706A-030 & 2-SS706A-030, It is not allowed in ERP.

[Tharwat]

Settle all your things of the program up first then write them all here clearly , otherwise I can not keep on guessing which is right and suitable for your needs .

[andy_lee]

Settle all your things of the program up first then write them all here clearly , otherwise I can not keep on guessing which is right and suitable for your needs .

 

I'm so sorry! sorry for my english. Master Tharwat.

your routine has reached 99.7% ,

 

0.1

 

0.2

 

0.3 If possible ,at last( after insert table), Deciding whether to output to xls(or csv)

 

This picture explaining what i mean. Hope that would be clearer.

Thanks so much! Master Tharwat.

[Tharwat]

01 : do you want to avoid including the duplicate drawing number into the table ? Show me with a sample drawing Before and After with the outcome you want .

02 : easy to add the BOM .

03 : you can export contents of any AutoCAD Table to Excel if you right click on the table and chose export ...

[andy_lee]

01 : do you want to avoid including the duplicate drawing number into the table ? Show me with a sample drawing Before and After with the outcome you want .

The DRAWING NO "2-SS706A-030" and "1-SS706A-030" ,the last(end) three digits is the same ! so need Red font .

 

 

This is the right.

 

 

 

02 : easy to add the BOM .

03 : you can export contents of any AutoCAD Table to Excel if you right click on the table and chose export ...

Great!!!

[Tharwat]

So you want the last two rows to be in red since there are with the same Drawing No. ?

[andy_lee]

So you want the last two rows to be in red since there are with the same Drawing No. ?

 

 

you are right .

row 13 and row 14 have same Drawing NO. ,so row 14 need to be in red since .

[andy_lee]

Hi

Master Tharwat. It doesn't clearer ?

[Tharwat]

Hi

Master Tharwat. It doesn't clearer ?

 

Re-read post number 36 and compare it with the attached image.

[andy_lee]

Re-read post number 36 and compare it with the attached image.

 

Master Tharwat. I don't understand . I don't know how to explain.

[Tharwat]

[ATTACH=CONFIG]51622[/ATTACH]

 

row 13 and row 14 have same Drawing NO. ,so row 14 need to be in red since .

 

Maybe you wanted to say 13 and 14 instead of ONLY 14 since they have the same Drawing No. in the two rows ?