博客网 >

;;Author: eachy 2010.06.25
(defun c:tt (/ fl excel fn fp wks shts sht na uc nfl cells i j lst
      maxrows nfp)
  (if (setq fl (getfiled "Please Select Excel files" "" "xlsx;xls" 8)) ;_excel Filename
    (progn
      (if
 (not
   (setq excel (vlax-get-or-create-object "Excel.Application")) ;_ Excel ActiveX
 )
  (progn
    (princ "\nExcel not Install!")
    (exit)
  )
      )
      (setq fn (vl-filename-base fl) ;_ Excel FileName
     fp (vl-filename-directory fl) ;_ Excel File Directory
      )
      (setq wks  (vlax-get excel 'workbooks) ;_ Workbooks
     shts (vlax-invoke wks 'open fl) ;_ Open Excel file , also can use Excel Findfile property
      )
      (setq sht (vlax-get excel 'sheets)) ;_Get Sheets
      (vlax-for sh sht ;_ Foreach all sheet
 (setq na      (vlax-get sh 'name) ;_ Sheet Name
       uc      (vlax-get sh 'usedrange) ;_UsedRange
       maxRows (vlax-get (vlax-get uc 'Rows) 'Count) ;_Number of Bottom Row in Used
       cells   (vlax-get sh 'Cells) ;_ActiveSheet Cells
       i       7
 )
 (while (<= i maxrows) ;_Get Needed Rangs
   (setq lst (cons (list
       (vlax-get (variant-value
     (vlax-get-property cells 'item i 2)
          )
          'text
       )
       (vlax-get (variant-value
     (vlax-get-property cells 'item i 3)
          )
          'text
       )
       (vlax-get (variant-value
     (vlax-get-property cells 'item i 4)
          )
          'text
       )
     )
     lst
      )
  i   (1+ i)
   )

  (setq lst nil)
 )
 (setq lst
        (vl-remove
   nil
   (reverse
     (mapcar
       '(lambda (x)
   (setq
     x
      (mapcar '(lambda (a) (vl-string-trim " " a))
       x
      )
   )
   (if (vl-every '(lambda (x) (= x "")) x)
     nil
     (if (= (last x) "")
       (list (car x) (cadr x))
       x
     )
   )
        )
       lst
     )
   )
        )
 ) ;_Prosss Space
 ;;Follow to write hdm files
 (setq nfl (strcat fp "\\" fn "_" na ".hdm"))
 (setq nfp (open nfl "w"))
 (write-line "zgh" nfp)
 (write-line "BEGIN,坝中1.00:1" nfp)
 (foreach x lst
   (if (= 3 (length x))
     (write-line
       (strcat (car x) "," (cadr x) "(" (last x) ")")
       nfp
     )
     (write-line (strcat (car x) "," (cadr x)) nfp)
   )
 )
 (close nfp)
      )
      (vlax-invoke-method excel "quit") ;_closed excel
      (if (vlax-object-released-p excel)
 (vlax-release-object excel) ;_this can not close excel
      )
    )
  )
  (princ)
)

<< 总结:Autocad 与 Exc... / 【转载】齐次坐标概念&&... >>

专题推荐

不平凡的水果世界

不平凡的水果世界

平凡的水果世界,平凡中的不平凡。 今朝看水果是水果 ,看水果还是水果 ,看水果已不是水果。这境界,谁人可比?在不平凡的水果世界里,仁者见仁,智者见智。

中国春节的那些习俗

中国春节的那些习俗

正月是农历新年的开始,人们往往将它看作是新的一年年运好坏的兆示期。所以,过年的时候“禁忌”特别多。当然,各个地方的风俗习惯不一样,过年的禁忌也是不一样的。

评论
0/200
表情 验证码:

eachy

  • 文章总数0
  • 画报总数0
  • 画报点击数0
  • 文章点击数0
个人排行
        博文分类
        日期归档