[编程交流] Excel到Cad

(defun readrow (xlsheet rownum / c1 cel cels celvalue cols r1 rowdata xlrange xlrow)
 
 (vlax-invoke-method xlsheet "Activate")          ;optional
 
 (setq xlrange (vlax-get-property xlsheet "UsedRange"))
 (setq        xlrow        (vlax-variant-value
          (vlax-get-property
            (vlax-get-property
              xlrange
              "Rows")
            "Item"
            rownum)))
 (setq cols (vlax-get-property
       (vlax-get-property xlrange "Columns")
       "Count")
)
 (vlax-invoke-method xlrange "Activate")          ;optional
 (vlax-invoke-method xlrange "Select")          ;optional
 (setq cels (vlax-get-property xlsheet "Cells"))
 (setq        r1   rownum                                  ; given row number
c1   1                                          ; initial column number in row
)                                         
 (while (<= c1 cols)
   (setq cel (vlax-variant-value
        (vlax-get-property
          cels
          "Item"
          ;; row number :
          (vlax-make-variant r1 vlax-vblong)
          ;; column number :
          (vlax-make-variant c1 vlax-vblong))))
   (setq celvalue (vlax-variant-value (vlax-get-property cel "Value2")))
   (setq rowdata (cons (vl-princ-to-string celvalue) rowdata))
   (setq c1 (1+ c1 )))
   (reverse rowdata)
 )
(defun readcolumn (xlsheet colnum / c1 cel cels celvalue columndata r1 rows xlrange xlrow)
 
 (vlax-invoke-method xlsheet "Activate")          ;optional
 
 (setq xlrange (vlax-get-property xlsheet "UsedRange"))
 (setq        xlrow        (vlax-variant-value
          (vlax-get-property
            (vlax-get-property
              xlrange
              "Rows")
            "Item"
            colnum)))
 (setq rows (vlax-get-property
       (vlax-get-property xlrange "Rows")
       "Count")
)
 (vlax-invoke-method xlrange "Activate")          ;optional
 (vlax-invoke-method xlrange "Select")          ;optional
 (setq cels (vlax-get-property xlsheet "Cells"))
 (setq        r1  1                                                   ; initial row number in column
c1  colnum                                          ; given column number
)                                         
 (while (<= r1 rows)
   (setq cel (vlax-variant-value
        (vlax-get-property
          cels
          "Item"
          ;; row number :
          (vlax-make-variant r1 vlax-vblong)
          ;; column number :
          (vlax-make-variant c1 vlax-vblong))))
   (setq celvalue (vlax-variant-value (vlax-get-property cel "Value2")))
   (setq columndata (cons (vl-princ-to-string celvalue) columndata))
   (setq r1 (1+ r1 )))
   (reverse columndata)
 )
;; Usage :
(defun C:GRD  (/
        *error*
        C1
        Cel
        Cels
        Celvalue
        Colnum
        Datalist
        Excelapp
        Filepath
        Findrang
        Findrow
        Lastcell
        R1
        Rownum
        Sht
        Shtnum
        Wbk)
 (defun *error*  (msg)
   ;; close workbook w/o saving changes 
   (vl-catch-all-apply
     'vlax-invoke-method
     (list Wbk "Close")
     )
   ;; quit Excel
   (vl-catch-all-apply
     'vlax-invoke-method
     (list ExcelApp "Quit")
     )
   ;; clean up of memory 
   (mapcar
     (function
(lambda        (x)
  (vl-catch-all-apply
    (function (lambda ()
                (if (not (vlax-object-released-p x))
                  (vlax-release-object x)
                  )
                )
              ))))
     (list Cel LastCell Cels FindRow FindRang Sht Wbk ExcelApp)
     )
   (setq Cel nil
  LastCell nil
  Cels nil
  FindRow nil
  FindRang nil
  Sht nil
  Wbk nil
  ExcelApp nil
  )
   (gc)
   (gc)
   (princ)
   )
 (setq        FilePath (getfiled "Select Excel file to read data:"
                   (getvar "dwgprefix")
                   "xls"
                   16
                   )
)
 (initget 6)
 (setq ShtNum (getint "\nEnter a sheet number <1>: "))
 (if (not ShtNum)
   (setq ShtNum 1))
 (initget 6)
 (setq RowNum (getint "\nEnter a row number <1>: "))
 (if (not RowNum)
   (setq RowNum 1))
   (initget 6)
 (setq ColNum (getint "\nEnter a column number <1>: "))
 (if (not ColNum)
   (setq ColNum 1))
 (setq ExcelApp (vlax-get-or-create-object "Excel.Application"))
 (vla-put-visible ExcelApp :vlax-true)                  ;or :vlax-false for invisible mode
 (setq        Wbk (vl-catch-all-apply
      'vla-open
      (list (vlax-get-property ExcelApp "WorkBooks") FilePath)))
 (setq        Sht (vl-catch-all-apply
      'vlax-get-property
      (list (vlax-get-property Wbk "Sheets")
            "Item"
            ShtNum)))
 (vlax-invoke-method Sht "Activate")
 
 (setq rowlist (readrow Sht RowNum))
 
 (setq columnlist (readcolumn Sht ColNum))
 
 (princ "\nRow data: ")
 
 (print rowlist)
 
 (princ "\nColumn data: ")
 
 (print columnlist)
 ;; --> work here with this data after
 (*error* "")
 (princ)
 )
(vl-load-com)