表格转换cad->excel

qqdswan

求教xyp大哥，能否把我上传的表格转换成excel格式，样式一定要一样的。
谢谢大哥了，我这里有一批的cad表格要转换成excel的，
能不能帮我解决这个问题呢？
谢谢了
谢谢了

hao3ren

这个是我以前找到的，因为不会编程，只好拿来用了
，可惜我用不了，不知错在哪里;;提取表格到文本中的程序，可以利用excel打开的时候选择分隔符号逗号来分开
;;by qjchen
;;练练手而已，功能比较弱，建议大家用truetable：）
;;要求r2000以上，要求所有的文本在格子中，每个格子只有一个文本，非常规则的表格
;;输出的文件是c:b2e.txt，
;;缺点:假如用excel打开这个文件的话，在cad中会出错，建议，可以用打开文本，拷贝到
;;excel中数据分列的方法，或者对这lisp的文件打开方式改为"a"，连续选择表格后再导入excel
(defun c:b2e ()
  (setvar "osmode" 33)
  (setq p1 (getpoint "\n左上角点："))
  (setq p3 (getpoint "\n右下角点："))
  (setvar "osmode" 0)
  (setq fn "c:/b2e.txt")
  (setq fh (open fn "w"))
  (setq p2 (list (car p1) (car (cdr p3)) 0))
  (setq p4 (list (car p3) (car (cdr p1)) 0))
  (setq p1a (polar p1 0 1))
  (setq p2a (polar p2 0 1))
  (setq p1b (polar p1 (* pi 1.5) 1))
  (setq p4b (polar p4 pi 1))
  (setq pvlist (vl-Get-Int-Pt p1a p2a))
  (setq pvlist (mapcar
         '(lambda (x)
            (polar x pi 1)
          )
         pvlist
           )
  )
  (setq phlist (vl-Get-Int-Pt p1b p4b))
  (setq palllist (list pvlist))
  (setq i 1)
  (repeat (- (length phlist) 1)
    (setq newpvlist (mapcar
              '(lambda (x)
             (list (car (nth i phlist)) (car (cdr x))
                   (car (cddr x))
             )
               )
              pvlist
            )
    )
    (setq palllist (append
             palllist
             (list newpvlist)
           )
    )
    (setq i (1+ i))
  )
  (setq column (length palllist))
  (setq row (length (nth 0 palllist)))
  (setq j 0)
  (repeat (- row 1)
    (setq i 0)
    (repeat (- column 1)
      (setq pa1 (nth j (nth i palllist)))
      (setq pa2 (nth (1+ j) (nth i palllist)))
      (setq pa3 (nth (1+ j) (nth (1+ i) palllist)))
      (setq pa4 (nth j (nth (1+ i) palllist)))
      (setq palist (list pa1 pa2 pa3 pa4))
      (SETQ SS (SSGET "WP" palist))
      (if (/= ss nil)
    (progn
      (SETQ EN (SSNAME SS 0))
      (SETQ ED (ENTGET EN))
      (setq ttext (cdr (assoc 1 ed)))
      (princ (strcat ttext ",") fh)
    )
    (princ (strcat ",") fh)
      )
      (setq i (1+ i))
    )
    (princ "\n" fh)
    (setq j (1+ j))
  )
  (close fh)
)


;;; 引用一个韩国朋友写的关于两点和多个物体交点的程序
(defun vl-Get-Int-Pt (FirstPoint SecondPoint / acadDocument mSpace SSetName
                 SSets SSet reapp ex obj Baseline
             )
  (vl-load-com)
  (setq acadDocument (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq mSpace (vla-get-ModelSpace acadDocument))
  (setq SSetName "MySSet")
  (setq SSets (vla-get-SelectionSets acadDocument))
  (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-add (list SSets
                                   SSetName
                             )
                )
      )
    (vla-clear (vla-Item SSets SSetName))
  )
  (setq SSet (vla-Item SSets SSetName))
  (setq Baseline (vla-Addline mspace (vlax-3d-point FirstPoint)
                  (vlax-3d-point SecondPoint)
         )
  )
  (vla-SelectByPolygon SSet acSelectionSetFence
               (kht:list->safearray (append
                          FirstPoint
                          SecondPoint
                        ) 'vlax-vbdouble
               )
  )
  (vlax-for obj sset (if (setq ex (kht-intersect
                         (vlax-vla-object->ename BaseLine)
                         (vlax-vla-object->ename obj)
                  )
             )
               (setq reapp (append
                     reapp
                     ex
                   )
               )
             )
  )
  (vla-delete BaseLine)
  (setq reapp (vl-sort reapp '(lambda (e1 e2)
                (< (car e1) (car e2))
                  )
          )
  )
  reapp
)


;;; 修改了一点，让text和其他的没有交点
(defun kht-intersect (en1 en2 / a b x ex ex-app c d e)
  (vl-load-com)
  (setq c (cdr (assoc 0 (entget en1)))
    d (cdr (assoc 0 (entget en2)))
  )
  (if (or
    (= c "TEXT")
    (= d "TEXT")
      )
    (setq e -1)
  )
  (setq En1 (vlax-ename->vla-object En1))
  (setq En2 (vlax-ename->vla-object En2))
  (setq a (vla-intersectwith en1 en2 acExtendNone))
  (setq a (vlax-variant-value a))
  (setq b (vlax-safearray-get-u-bound a 1))
  (if (= e -1)
    (setq b e)
  )
  (if (/= b -1)
    (progn
      (setq a (vlax-safearray->list a))
      (repeat (/ (length a) 3)
    (setq ex-app (append
               ex-app
               (list (list (car a) (cadr a) (caddr a)))
             )
    )
    (setq a (cdr (cdr (cdr a))))
      )
      ex-app
    )
    nil
  )
)

(defun kht:list->safearray (lst datatype)
  (vlax-safearray-fill (vlax-make-safearray (eval datatype) (cons 0
                                  (1-
                                      (length lst)
                                  )
                                )
               ) lst
  )

xyp1964

不会啊！

hao3ren

那麻烦xyp1964给讲一下，是怎么在cad里面调用的啊

lb945227

有个好用的工具推荐你用一下：真实表格，强烈推荐你用一下，相信你会喜欢上它的强大功能的

aleopard

Truetable要注册，有点烦。