(member) function, need a boolean return, help!!

[Bhull1985]

Hey all, still progressing as best I can with this application to send attribute information to excel.

 

In order to handle duplicate tags we've decided that the app should flag the items within excel, and the easiest way that I've seen to do this programmatically is to color the excel cells based on if the values for that cell are part of a list of duplicate tag values.

 

The problem I'm facing is that if I use the (member) function in this manner:

(setq ldata (list bdata adata))
("18" "TT")
Command: !ldata
("18" "TT")
Command: (member @dupeslist ldata)
nil
Command: (member ldata @dupeslist)
(("18" "TT") ("612" "FQ") ("312" "TI") ("12" "FT") ("22" "FE") ("313" "TI"))

 

and as you can see there , and as to be expected the member function is returning the @dupeslist. I need to fire a subfunction off if "ldata" is in @dupeslist, because this will tell me that it's a duplicate tag and that the cell it's being placed into should be colored. I've got that code accomplished, i'm having trouble finding a way to be able to set up a conditional that will work with the member function.

 

I'm sure it's just lack of experience in doing this, because I know it can be done. I tried looking into (boole) but that required bit-code arguments that did not seem helpful or useful.

 

For completeness, here's more of the subfunction that i'll be using the call to member in, so you all can see how it's being used.

 

(setq cell (strcat "B" @excel_row))
;;starting cell value to leave one line from the top for a column header
;;subfunction (string_ cell) will increment to "A2" and then
;;"A3", incrementing each pass of the repeat loop until the end of the list.
(setq dupedlist (list nil))
(setq c 0)
(setq len (length vallist))
(repeat len
(setq data (nth c vallist))
(setq adata (cadr data))
(setq bdata (car data))
(if (not fdata)
(setq fdata (strcat adata "-" bdata)))
(setq cell (string_ cell))
(putcell cell fdata)
(setq ldata (list adata bdata))
(member ldata @dupeslist);; putcolor function would need to follow this line IF an item matches an item in the @dupeslist
(setq fdata nil)
(setq c (1+ c))
);repeat
(if (= c len)(doname len))
;;passes number of items entered to next subroutine to enter
;;information into the next column of excel. This time it's
;;the dwg-name, which should be the same per dwg.
);defun

 

 

 

Thanks to all of you , very much!

Any assistance is greatly appreciated, this one is a headache for me but i'm getting through it, no small thanks to the community

[MSasu]

Maybe I didn't understood you correctly, but you can use for test what MEMBER function returns (that it, because everything different than nil is equivalent with True):

[color=red](if[/color] (member ldata @dupeslist) 
(progn
[color=blue]  ;;;action for TRUE[/color]
) 
(progn
[color=blue]  ;;;action for FALSE[/color]
)
[color=red])[/color]

[Bhull1985]

thank you Msasu that suffices quite well for my purposes. Now just to get the program to stop acting strange....take a look here for more info what it's doing suddenly

http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/member-function-need-a-boolean-return-help/m-p/4880924/highlight/false#M320447

if you'd care to. I sure could use the help been working on this all week and suddenly it capoots

[BlackBox]

and as you can see there , and as to be expected the member function is returning the @dupeslist. I need to fire a subfunction off if "ldata" is in @dupeslist, because this will tell me that it's a duplicate tag and that the cell it's being placed into should be colored. I've got that code accomplished, i'm having trouble finding a way to be able to set up a conditional that will work with the member function.

 

I'm sure it's just lack of experience in doing this, because I know it can be done. I tried looking into (boole) but that required bit-code arguments that did not seem helpful or useful.

 

The IF test expression need only be non-Nil, so the returned list from a call to MEMBER is sufficient:

 

;; IF an item matches an item in the @dupeslist
(if (member ldata @dupeslist)
 ;; putcolor function
)

 

 

 

[Edit] - MSasu posted while typing.

[Tharwat]

This ?

 

(setq ldata '("18" "TT"))

(vl-remove-if-not
 '(lambda (x) (and (eq (car x) (car ldata)) (eq (cadr x) (cadr ldata))))
 '(("18" "TT") ("612" "FQ") ("312" "TI") ("12" "FT") ("22" "FE") ("313" "TI"))
)

[Bhull1985]

Okay, got it on the conditional to get my "Boolean" return on the member function. Not Boolean but acts as one for my purposes at least.

Tharwat, thanks for that....the @dupeslist variable will change depending on which tags are duplicated.....actually, there should be zero duplicate tags but human error leads to a few here and there and this is our way to flag them....so, i'm going to try and figure out how to use that effectively if the @dupeslist changes.

I'm just not sure how to use that tharwat....when I put it into cad it returned the first item:

(vl-remove-if-not
(_>   '(lambda (x) (and (eq (car x) (car ldata)) (eq (cadr x) (cadr ldata))))
(_>   '(("18" "TT") ("612" "FQ") ("312" "TI") ("12" "FT") ("22" "FE") ("313" 
"TI"))
(_> )
(("18" "TT"))

 

and why am I getting that consp error??!

[BlackBox]

This ?

 

(setq ldata '("18" "TT"))

(vl-remove-if-not
 '(lambda (x) (and (eq (car x) (car ldata)) (eq (cadr x) (cadr ldata))))
 '(("18" "TT") ("612" "FQ") ("312" "TI") ("12" "FT") ("22" "FE") ("313" "TI"))
)

 

... Or, to check for duplicates:

 

(if
 (< 1
    (length
      (vl-remove-if-not
 (function (lambda (x) (equal ldata x)))
 @dupeslist
      )
    )
 )
 ;; duplicates found
)

[Tharwat]

... Or, to check for duplicates:

 

 

I added the length function before I posted my example but I removed because I still don't know the whole story of what the OP have in their mind

[Bhull1985]

Here hopefully this will help Tharwat

Thank you all very much!!!

Guys thank you but I have no idea how to effectively use those pieces of code.

Please take note of what I'm trying to accomplish....

I've got my list of values, Vallist

I've got my list of duplicates that are within vallist, @dupeslist.

I need to PutColor the excel cells that are duplicate tag values, i.e. the (member) call,

but all of the tags are being placed into excel regardless. Just only the ones that are duplicated will get the PutColor.

 

I'm just trying to see why it's not working for me......i'm getting a consp error and it's coloring *all* of the values instead of just the duplicate ones.

Here's the code again

Bolded,italics, and underline for the two areas of problems

 

(defun PutCell (StartCell$ Data@ / Cell$ Column# ExcelRange Row#)
 (if (= (type Data@) 'STR)
   (setq Data@ (list Data@))
 )
 (setq ExcelRange (vlax-get-property *ExcelApp% "Cells"))
 (if (Cell-p StartCell$)
   (setq Column# (car (ColumnRow StartCell$))
         Row# (cadr (ColumnRow StartCell$))
   );setq
   (if (vl-catch-all-error-p
         (setq Cell$ (vl-catch-all-apply 'vlax-get-property
           (list (vlax-get-property *ExcelApp% "ActiveSheet") "Range" StartCell$))
         );setq
       );vl-catch-all-error-p
       (alert (strcat "The cell ID \"" StartCell$ "\" is invalid."))
       (setq Column# (vlax-get-property Cell$ "Column")
             Row# (vlax-get-property Cell$ "Row")
       );setq
   );if
 );if
 (if (and Column# Row#)
  [b][i][u] (foreach Item Data@[/u][/i][/b]
[u][i][b]      (vlax-put-property ExcelRange "Item" Row# Column# (vl-princ-to-string Item));;erroring here!![/b][/i][/u]
[u][i][b]      (setq Column# (1+ Column#))[/b][/i][/u]
[u][i][b]    );foreach[/b][/i][/u]
 );if
 (princ)
);defun PutCell
;-------------------------------------------------------------------------------
; CloseExcel - Closes Excel spreadsheet
; Arguments: 1
;   ExcelFile$ = Excel saveas filename or nil to close without saving
; Syntax examples:
; (CloseExcel "C:\\Temp\\Temp.xls") = Saveas C:\Temp\Temp.xls and close
; (CloseExcel nil) = Close without saving
;-------------------------------------------------------------------------------
(defun CloseExcel (ExcelFile$ / Saveas)
 (if ExcelFile$
   (if (= (strcase ExcelFile$) (strcase *ExcelFile$))
     (if (findfile ExcelFile$)
       (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") "Save")
       (setq Saveas t)
     );if
     (if (findfile ExcelFile$)
       (progn
         (vl-file-delete (findfile ExcelFile$))
         (setq Saveas t)
       );progn
       (setq Saveas t)
     );if
   );if
 );if
 (if Saveas
   (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook")
     "SaveAs" ExcelFile$ -4143 "" "" :vlax-false :vlax-false nil
   );vlax-invoke-method
 );if
 (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close :vlax-False)
 (vlax-invoke-method *ExcelApp% 'Quit)
 (vlax-release-object *ExcelApp%)(gc)
 (setq *ExcelApp% nil *ExcelFile$ nil)
 (princ)
);defun CloseExcel
;-------------------------------------------------------------------------------
; ColumnRow - Returns a list of the Column and Row number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Cell$ = Cell ID
; Syntax example: (ColumnRow "ABC987") = '(731 987)
;-------------------------------------------------------------------------------
(defun ColumnRow (Cell$ / Column$ Char$ Row#)
 (setq Column$ "")
 (while (< 64 (ascii (setq Char$ (strcase (substr Cell$ 1 1)))) 91)
   (setq Column$ (strcat Column$ Char$)
         Cell$ (substr Cell$ 2)
   );setq
 );while
 (if (and (/= Column$ "") (numberp (setq Row# (read Cell$))))
   (list (Alpha2Number Column$) Row#)
   '(1 1);default to "A1" if there's a problem
 );if
);defun ColumnRow

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;DUPLICATE TAG CELL COLOR SUBFUNCTION;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(DEFUN PutColor (RNG COL)
 (VLAX-PUT-PROPERTY
   (VLAX-GET-PROPERTY
     (VLAX-GET-PROPERTY (VLAX-GET-OR-CREATE-OBJECT "Excel.Application") "Range" RNG)
     "Interior"
   )
   "Colorindex"
   (VLAX-MAKE-VARIANT COL)
 )
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;list duplicates subfunction;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; List Duplicates  -  Lee Mac
;; Returns a list of items appearing more than once in a supplied list
(defun LM:ListDupes ( l )
   (if l
       (if (member (car l) (cdr l))
           (cons (car l) (LM:ListDupes (vl-remove (car l) (cdr l))))
           (LM:ListDupes (vl-remove (car l) (cdr l)))
       )
   )
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;string increment subfunction;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun String_ (In_Str / OutStr AddFlg DecFlg TmpLst)
 (setq OutStr
   (vl-list->string
     (foreach ForElm (reverse (vl-string->list In_Str))
       (if AddFlg
         (setq TmpLst (cons ForElm TmpLst))
         (cond
           ( (= 57 ForElm)    ;(chr 57)=> "9"
             (setq DecFlg T  TmpLst (cons 48 TmpLst))
           )
           ( (> 57 ForElm 47) ;"8"->-"0"  (chr 47)=> "/"
             (setq AddFlg T  TmpLst (cons (1+ ForElm) TmpLst))
           )
           ( (if DecFlg                          ; (chr  49)=> "1"
               (setq AddFlg T  TmpLst (cons ForElm (cons 49 TmpLst)))
               (setq TmpLst (cons ForElm TmpLst))
             )
           )
         )
       )
     )
   )
 )
 (if AddFlg OutStr (strcat OutStr "1"))
);defun


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;PUTEXCELLS;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun putexcells ( vallist dupeslist / c data adata bdata fdata ldata cell)
;;main subfunction that will process the selection set gathered by C:Putex
;;this subfunction will place tag strings into excel columns and rows
;;then will number all of the items in excel in column "A", listing only
;;a number that increments for each tag in the list.
;;the program will then put the drawing number beside the tag values within excel

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;COL "B";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;do-tag# subfunction;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;putex-->tag#-->name;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq cell (strcat "B" @excel_row))
;;starting cell value to leave one line from the top for a column header
;;subfunction (string_ cell) will increment to "A2" and then
;;"A3", incrementing each pass of the repeat loop until the end of the list.
(setq dupedlist (list nil))
(setq c 0)
(setq len (length vallist))
(repeat len
(setq data (nth c vallist))
(setq adata (cadr data))
(setq bdata (car data))
(if (not fdata)
(setq fdata (strcat adata "-" bdata)))
(setq cell (string_ cell))
(putcell cell fdata)
[i][b][/b][/i][i][b][u](setq ldata (list bdata adata))[/u][/b][/i]
[i][b][/b][/i][i][b][u](if[/u][/b][/i]
[i][b][/b][/i][i][b][u](member ldata @dupeslist)[/u][/b][/i]
[i][b][/b][/i][i][b][u](putcolor cell 15)[/u][/b][/i]
[i][b][/b][/i][i][b][u]);if[/u][/b][/i]
(setq fdata nil)
(setq c (1+ c))
);repeat
(if (= c len)(doname len))
;;passes number of items entered to next subroutine to enter
;;information into the next column of excel. This time it's
;;the dwg-name, which should be the same per dwg.
);defun


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;COL "E";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;do-name subfunction;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;tag#-->name-->item;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun doname (len / c cell namedata)
(setq c 0)
(setq cell (strcat "E" @excel_row))
(setq cell (string_ cell))
(repeat len
(setq namedata (getname))
(putcell cell namedata)
(setq cell (string_ cell))
(setq c (1+ c))
);repeat
(if (= c len)(doitem len))
;;goto item subfunction
);defun doname

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;COL "A";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;do-item subfunction;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;name-->item-->type;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun doitem ( len / itemcell itemdata c)
(setq c 0)
(setq itemcell (strcat "A" @excel_row))
(setq itemcell (string_ itemcell))
(setq itemdata "00")
(repeat len
(setq itemdata (string_ itemdata))
(putcell itemcell itemdata)
(setq itemcell (string_ itemcell))
(setq c (1+ c))
);repeat
(if (= c len)(dotype len))
;;goto type subfunction
);defun doitem

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;COL "C";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;do-type subfunction;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;item-->type-->tag;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dotype ( len / cell c data adata)
(setq c 0)
(setq cell (strcat "C" @excel_row))
(setq cell (string_ cell))
(repeat len
(setq data (nth c vallist))
(setq adata (cadr data))
(putcell cell adata)
(setq cell (string_ cell))
(setq c (1+ c))
);repeat
(if (= c len)(dotag len))
;;goto tag subfunction
);defun dotype

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;COL "D";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;do-tag subfunction;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;type-->tag-->end;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dotag ( len / c cell data adata)
(setq c 0)
(setq cell (strcat "D" @excel_row))
(setq cell (string_ cell))
(repeat len
(setq data (nth c vallist))
(setq adata (car data))
(putcell cell adata)
(setq cell (string_ cell))
(setq c (1+ c))
);repeat
(princ "\n....Finished!")
(princ (strcat "\n...." (itoa (length dupedlist)) " items duplicate"))
(princ)
;;end of excel input, routine will alert to user that it is complete
(princ)
);defun dotype

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;getname subfunction for col "E";;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun getname (/ dwgname tempname1 dwgname1)
;;subfunction that returns simply the last 5 characters of a dwg name before the ".dwg"
;;ex output on "213035-PIPE-PID-00000500-00.DWG" returns "00500"
;;bhull 2/27/14
(setq dwgname (getvar "dwgname"))
(setq tempname1 (substr dwgname (+ -7 (vl-string-search ".dwg" dwgname))))
(setq dwgname1 (substr tempname1 1 (- (strlen tempname1) 7)))
(princ)
);defun

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;put-excel main function;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:putex (/ TAGROW VALROW EDATA E I SS TAGLIST TEMPLIST REVLIST vallist)
;;custom routine to search drawing for listed tags in listed blocks
;;and write the values to an instrument index in excel as a .csv
;(openexcel @excel_file "INDEX" T)
(openexcel "Y:\\Bhull\\213035-INST-IND-00000001-00.xls" "INDEX" T)
;;one and final call to (openexcel) that opens "attributes.csv" for
;;programatically editing with this routine
(if @dupeslist
(setq @dupeslist nil)
)
(setq TagList '("TAG00" "TAG10"))
(setq ss (ssget "_X" (list (cons 0 "INSERT")(cons 2 "CE001,CE007,CE013,CE023,CE021"))))
(setq i -1)
(repeat (sslength ss)
(setq TagRow nil
      ValRow nil)
  (setq Edata (entget (setq e (ssname ss (setq i (1+ i))))))
  (while (/= (Dxf 0 Edata) "SEQEND")
     (if
       (and
         (= (Dxf 0 Edata) "ATTRIB")
         (member (dxf 2 Edata) TagList)
         ;;if tag is on list
          ) ;and
        (progn
          (setq TagRow (cons (Dxf 2 Edata) TagRow))
          (setq valRow (cons (Dxf 1 Edata) ValRow))
          ) ;progn
)
     (setq Edata (entget (setq e (entnext e))))
     ) ;while
(setq vallist (cons valrow vallist))
) ;repeat 
(foreach sublist vallist
 (setq templist (list (vl-string-trim " " (car sublist)) (vl-string-trim " " (cadr sublist))))
 (if (not (equal templist '("" ""))); had other than space(s)-only content
   (setq revlist (cons templist revlist))
 ); if
); foreach
(setq vallist (reverse revlist))
;;code is to remove empty strings and spaces from the items within vallist

(setq @dupeslist (reverse (lm:listdupes vallist)))
;;creates list of duplicate items in order to flag and color excel cells for duplicate items
(princ)
(if vallist
(putexcells vallist @dupeslist)
;;command to execute next part of routine, putexcells, to put all items
;;in vallist into excel spreadsheet as .csv file
);if
;;THIS RESETS THE VALLIST VARIABLE TO BECOME EMPTY AT END OF ROUTINE
;;SO IT RUNS PROPERLY THE FOLLOWING TIME
;(setq @dupeslist nil)
(princ)
);defun

[Tharwat]

You can use the example that have been given by BB in post No#7 to check for duplicates , so if a variable match the criteria , so color the cell , otherwise pass this step .

[BlackBox]

I added the length function before I posted my example but I removed because I still don't know the whole story of what the OP have in their mind

 

No worries, my friend.