Подсчет количества блоков в чертеже (Страница 2 из 3)

(defun c:blcx(/ blSet blList nameList listLen outList exFlag oldExFlag
           exPath exApp exWorkbook exFileexSheets exSheet curId
           newFile curCell curVal)
  (vl-load-com)
  (princ "\n*** Select entities on wanted layers *** ")
  (setq laySet(ssget)
    dxfList(mapcar
         'entget
           (vl-remove-if 'listp
                     (mapcar 'cadr(ssnamex laySet))))
    dxfList(mapcar
         '(lambda(x)(assoc 8 x))dxfList)
    filList '()
    ); end setq
  (foreach lst dxfList
    (if(not(member(cdr lst)(mapcar 'cdr filList)))
      (setq filList(append filList(list lst)))
      ); end if
    ); end foreach
  (princ "\n******* Layers List for Blocks Counting ******* \n")
  (foreach lay filList
    (princ(strcat "\n"(cdr lay)))
    ); end of foreach
  (princ "\n********************************************** ")
  (textscr)
  (setq filList(append '((-4 . "<OR"))filList)
    filList(append filList '((-4 . "OR>")))
    filList(append '((0 . "INSERT"))filList)
    ); end setq
        
  (princ "\n*** Specify selection set by frame selection *** ")
  (if
    (setq blSet(ssget filList))
    (progn
      (setq blList(mapcar 'vlax-ename->vla-object
                    (vl-remove-if 'listp
                     (mapcar 'cadr(ssnamex blSet))))
        nameList(vl-sort (mapcar'(lambda(X)(vla-get-Name x)) blList) '<)
        listLen(length nameList)
        ); end setq
      (while nameList
  (setq outList (cons(cons(car nameList)
           (- listLen(setq listLen(length (setq nameList
       (vl-remove(car nameList) nameList))))))outList)
        ); end setq
  ) ; end while
      (princ "\n********** BLOCK COUNTING REPORT ************\n ")
      (foreach item outList
    (princ(strcat "\n" (car item)" "(itoa(cdr item))))
    ); end foreach
      (princ "\n \n************* END OF REPORT *****************")
      (textscr)
      (if(not exFlag)(setq exFlag "N"))
      (setq oldExFlag exFlag)
      (initget "Y N")
      (setq exFlag
         (getkword
        (strcat "\n\n*** Save report to MS Excel file? [Y/N] <"exFlag">: ")))
      (if(null exFlag)(setq exFlag oldExFlag))
      (if(= exFlag "Y")
    (progn
       (if (setq  exPath(getfiled "Save Text File As"
           (strcat (getvar "dwgprefix")(substr (getvar "dwgname") 1
        (- (strlen (getvar "dwgname")) 4)) ".xls")"xls" 33); end getfiled
            ); end setq
         (progn
    (setq exApp(vlax-create-object "Excel.Application"))
    (if(null exApp)
      (progn
        (alert "Error. Can't start MS Excel.")
        (quit)
        ); end progn
        ); end if
     (setq exWorkbook
               (vlax-get-property exApp "Workbooks")
           exFile
               (vlax-invoke-method exWorkbook "Add")
           exSheets
               (vlax-get-property exFile "Worksheets")
               exSheet
               (vlax-get-property exSheets "Item" "Sheet1")
           curRow 2
    ); end setq
      (repeat(length outList)
        (setq curId(strcat "B"(itoa curRow))
          curCell(vlax-variant-value
                 (vlax-invoke-method exSheet "Evaluate" curId))
          curVal(car(nth(- curRow 2) outList))
          ); end setq
          (vlax-put-property curCell  "Formula" curVal)
        (vlax-release-object curCell)
        (setq curId(strcat "C"(itoa curRow))
          curCell(vlax-variant-value
                 (vlax-invoke-method exSheet "Evaluate" curId))
          curVal(itoa(cdr(nth(- curRow 2) outList)))
          ); end setq
          (vlax-put-property curCell  "Formula" curVal)
        (vlax-release-object curCell)
        (setq curRow(1+ curRow))
        ); end repeat
      (vlax-invoke-method exFile "SaveAs" exPath nil nil nil nil nil nil)
      (vlax-invoke-method exFile "Close" nil)
      (vlax-invoke-method exApp "Quit")
    (mapcar(function(lambda(x)
           (if
         (and x(not(vlax-object-released-p x)))
         (vlax-release-object x)
         )
           ))
    (list curCell exSheet exSheets exFile exWorkbook exApp)
    )
    (setq curCell nil
          exSheet nil
          exSheets nil
          exFile nil
      exWorkbook nil
      exApp nil); end setq
    (gc)
    (princ(strcat"\n*** The file was successfully saved in: " exPath))
    ); end progn
         (princ "\n*** Excel file was not created! *** ")
         ); end if
       ); end progn
      ); end if
    ); end progn
    (princ "\n*** Nothing blocks selected! ***")
  ); end if
      (princ)
      ); end of BLCX