CAD与EXCEL相互转化并自动画图

立冬 · 发表于 2019-1-13 16:22:07

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由立冬于 2019-1-13 17:04 编辑

论坛的各位大神你们好：
以前都是手动画图，效率太低。求各位帮忙能否将附件内的EXCEL数据直接转画到CAD中。小弟在此拜谢了！！！

newer · 发表于 2019-1-13 16:28:43

为保证帖子清晰，请截取图片传上来。

立冬 · 发表于 2019-1-13 17:05:58

newer 发表于 2019-1-13 16:28
为保证帖子清晰，请截取图片传上来。

好的，已截图重传！

st788796 · 发表于 2019-1-13 17:45:12

定义两个块
1 里程标记
2 中间的标注

画 pline 后插入块

aisong220 · 发表于 2019-1-13 18:22:23

哈哈哈哈哈哈，给力

longer88 · 发表于 2019-1-14 07:16:20

这个功能不错

立冬 · 发表于 2019-1-14 07:32:53

st788796 发表于 2019-1-13 17:45
定义两个块
1 里程标记
2 中间的标注

那不还是要一个一个画吗？

qxwangtao · 发表于 2019-1-14 08:41:06

这个能实现就厉害了

yangjian001 · 发表于 2019-1-14 08:58:51

做一个热心并受欢迎的人

konglong604 · 发表于 2019-1-14 08:59:41

块就是先画一次，后面就不用画了，重复利用。

st788796 · 发表于 2019-1-14 16:02:01

本帖最后由 st788796 于 2019-1-15 10:42 编辑

更新：

增加粗线绘制，里程加上 "+"

仅对提供的样图，没有加入绘制粗线

(defun c:tt (/ _ADDATTRIBUTE _mkfont _mkblock
_insert _setlayer _mkblocklc p
lst str sl el date
tmp len bp
)
(defun _mkfont (/ ts)
(if (not (tblsearch "style" "x_efont"))
(progn
(setq ts (vla-add (vla-get-textstyles *xd:doc*) "x_efont"))
(vla-setfont
ts "Times New Roman" :vlax-false :vlax-false 1 0)
)
)
)
(defun _setlayer (obj)
(vla-put-layer obj "0")
(vla-put-color obj acbylayer)
)
(defun _mkblocklc (/ blkdef ln)
(if (not (tblsearch "block" "gk_x0"))
(progn
(setq blkdef (vla-add (vla-get-blocks *xd:doc*)
(vlax-3d-point '(0 0 0))
"gk_x0"
)
)
(setq ln (vla-addline
blkdef
(vlax-3d-point '(0 -5.0 0))
(vlax-3d-point '(0 5 0))
)
)
(_setlayer ln)
(setq ln (vla-addline
blkdef
(vlax-3d-point '(0 10.0 0))
(vlax-3d-point '(0 35 0))
)
)
(_setlayer ln)
(setq att (vla-addattribute
blkdef
3.0
acAttributeModeVerify
"LC"
(vlax-3d-point '(-1 15 0))
"LC"
"+666.0"
)
)
(_setlayer att)
(vla-put-stylename att "x_efont")
(vla-put-alignment att acAlignmentFit)
(vla-put-textalignmentpoint att (vlax-3d-point '(-1 30 0)))
)
)
)
(defun _mkblock (/ _addattribute blkdef circle att txt)
(defun _addattribute (obj h prmpt inspt tag val aln / att)
(setq att (vla-addattribute
obj
h
acAttributeModeVerify
prmpt
(vlax-3d-point inspt)
tag
val
)
)
(if (not (eq aln acAlignmentLeft))
(progn
(vla-put-alignment att aln)
(vla-put-textalignmentpoint att (vlax-3d-point inspt))
)
)
(vla-put-stylename att "x_efont")
(_setlayer att)
)
(if (not (tblsearch "block" "gk_x"))
(progn
(setq blkdef (vla-add (vla-get-blocks *xd:doc*)
(vlax-3d-point '(0 0 0))
"gk_x"
)
)
(setq circle (vla-addcircle
blkdef
(vlax-3d-point '(-16.8 -2.6 0.0))
2.0
)
)
(_setlayer circle)
(setq txt (vla-addtext
blkdef
"ts="
(vlax-3d-point '(4.4 -3.5 0.0))
2.5
)
)
(vla-put-stylename txt "x_efont")
(_setlayer txt)
(_addattribute
blkdef 3.0 "Date"
'(0 0 0) "DATE" "2019.1.1"
acAlignmentBottomCenter
)
(_addattribute
blkdef 2.0 "Number"
'(-16.8 -2.6 0.0) "N" "1"
acAlignmentmiddleCenter
)
(_addattribute
blkdef 2.0 "Index" '(-13.9 -4.6 0.0) "INDEX" "I"
acAlignmentLeft)
(_addattribute
blkdef 2.0 "Length"
'(-3.4 -2.6 0.0) "LENGTH" "2000.0"
acAlignmentMiddleCenter
)
(_addattribute
blkdef 2.0 "temp" '(9.3 -3.5 0.0) "TS" "23.0" acAlignmentLeft)
)
)
)
(defun _insert (point date n i len d / blkref tag atts)
(setq blkref (vla-insertblock
(vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
(vlax-3d-point point)
"gk_x"
1.0
1.0
1.0
0.0
)
)
(setq atts (vlax-invoke blkref 'getattributes))
(foreach att atts
(setq tag (strcase (vla-get-tagstring att)))
(cond
((eq tag "DATE")
(vla-put-textstring att date)
)
((eq tag "N") (vla-put-textstring att n))
((eq tag "INDEX") (vla-put-textstring att i))
((eq tag "LENGTH") (vla-put-textstring att len))
((eq tag "TS") (vla-put-textstring att (strcat d "%%dC")))
(t)
)
)
)
(defun _insertlc (p str / blkref atts tag)
(setq blkref (vla-insertblock
(vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
(vlax-3d-point p)
"gk_x0"
1.0
1.0
1.0
0.0
)
)
(setq atts (vlax-invoke blkref 'getattributes))
(foreach att atts
(setq tag (strcase (vla-get-tagstring att)))
(if (eq tag "LC")
(vla-put-textstring att str)
)
)
)
(defun XD::Excel:getActiveUsedRangeValues
(/ _usedrangevalued excel sh lst)
(defun _usedrangevalue (sh)
(mapcar
(function (lambda (x) (mapcar 'vlax-variant-value x)))
(vlax-safearray->list
(variant-value
(vlax-get-property (vlax-get sh 'usedrange) 'value)
)
)
)
)
(if (setq excel (vlax-get-or-create-object "Excel.Application"))
(progn
(setq sh (vlax-get excel 'activesheet)
lst (_usedrangevalue sh)
)
(vlax-release-object excel)
)
)
lst
)
(vl-load-com)
(if (and (setq p (getpoint "\nstartpoint: "))
(setq lst (cdr (XD::EXCEL:GETACTIVEUSEDRANGEVALUES)))
(setq lst
(vl-remove
nil
(mapcar
(function
(lambda (a)
(if
(vl-some
(function (lambda (b) (or (equal b "") (null b)))
)
a
)
nil
a
)
)
)
lst
)
)
)
(> (length lst) 1)
)
(progn
(setq bp p)
(_mkfont)
(_mkblock)
(_mkblocklc)
(foreach x lst
(mapcar 'set '(str sl el len date tmp) x)
(_insertlc p (strcat "+" (rtos sl 2 3)))
(_insert (mapcar '+ p (list (* 0.05 len) 0. 0.))
date
(substr str 1 2)
(substr str 3)
(rtos len 2 2)
(rtos tmp 2 1)
)
(setq p (polar p 0. (* 0.1 len)))
)
(mapcar 'set '(str sl el len date tmp) (last lst))
(_insertlc p (strcat "+" (rtos el 2 3)))
(setq pl (xdrx_polyline_make bp p))
(xdrx_polyline_setconstantwidth pl 0.5)
)
)
(princ)
)

(defun c:tt (/               _ADDATTRIBUTE           _mkfont   _mkblock 
             _insert   _setlayer _mkblocklc             p 
             lst       str         sl           el             date 
             tmp       len         bp 
            ) 
  (defun _mkfont (/ ts) 
    (if        (not (tblsearch "style" "x_efont")) 
      (progn 
        (setq ts (vla-add (vla-get-textstyles *xd:doc*) "x_efont")) 
        (vla-setfont 
          ts "Times New Roman" :vlax-false :vlax-false 1 0) 
      ) 
    ) 
  ) 
  (defun _setlayer (obj) 
    (vla-put-layer obj "0") 
    (vla-put-color obj acbylayer) 
  ) 
  (defun _mkblocklc (/ blkdef ln) 
    (if        (not (tblsearch "block" "gk_x0")) 
      (progn 
        (setq blkdef (vla-add (vla-get-blocks *xd:doc*) 
                              (vlax-3d-point '(0 0 0)) 
                              "gk_x0" 
                     ) 
        ) 
        (setq ln (vla-addline 
                   blkdef 
                   (vlax-3d-point '(0 -5.0 0)) 
                   (vlax-3d-point '(0 5 0)) 
                 ) 
        ) 
        (_setlayer ln) 
        (setq ln (vla-addline 
                   blkdef 
                   (vlax-3d-point '(0 10.0 0)) 
                   (vlax-3d-point '(0 35 0)) 
                 ) 
        ) 
        (_setlayer ln) 
        (setq att (vla-addattribute 
                    blkdef 
                    3.0 
                    acAttributeModeVerify 
                    "LC" 
                    (vlax-3d-point '(-1 15 0)) 
                    "LC" 
                    "+666.0" 
                  ) 
        ) 
        (_setlayer att) 
        (vla-put-stylename att "x_efont") 
        (vla-put-alignment att acAlignmentFit) 
        (vla-put-textalignmentpoint att (vlax-3d-point '(-1 30 0))) 
      ) 
    ) 
  ) 
  (defun _mkblock (/ _addattribute blkdef circle att txt) 
 
    (defun _addattribute (obj h prmpt inspt tag val aln / att) 
      (setq att        (vla-addattribute 
                  obj 
                  h 
                  acAttributeModeVerify 
                  prmpt 
                  (vlax-3d-point inspt) 
                  tag 
                  val 
                ) 
      ) 
      (if (not (eq aln acAlignmentLeft)) 
        (progn 
          (vla-put-alignment att aln) 
          (vla-put-textalignmentpoint att (vlax-3d-point inspt)) 
        ) 
      ) 
      (vla-put-stylename att "x_efont") 
      (_setlayer att) 
    ) 
    (if        (not (tblsearch "block" "gk_x")) 
      (progn 
        (setq blkdef (vla-add (vla-get-blocks *xd:doc*) 
                              (vlax-3d-point '(0 0 0)) 
                              "gk_x" 
                     ) 
        ) 
        (setq circle (vla-addcircle 
                       blkdef 
                       (vlax-3d-point '(-16.8 -2.6 0.0)) 
                       2.0 
                     ) 
        ) 
        (_setlayer circle) 
        (setq txt (vla-addtext 
                    blkdef 
                    "ts=" 
                    (vlax-3d-point '(4.4 -3.5 0.0)) 
                    2.5 
                  ) 
        ) 
        (vla-put-stylename txt "x_efont") 
        (_setlayer txt) 
        (_addattribute 
          blkdef           3.0                    "Date" 
          '(0 0 0)           "DATE"            "2019.1.1" 
          acAlignmentBottomCenter 
         ) 
        (_addattribute 
          blkdef            2.0                      "Number" 
          '(-16.8 -2.6 0.0) "N"                      "1" 
          acAlignmentmiddleCenter 
         ) 
        (_addattribute 
          blkdef 2.0 "Index" '(-13.9 -4.6 0.0) "INDEX" "I" 
          acAlignmentLeft) 
        (_addattribute 
          blkdef             2.0                "Length" 
          '(-3.4 -2.6 0.0)   "LENGTH"                "2000.0" 
          acAlignmentMiddleCenter 
         ) 
        (_addattribute 
          blkdef 2.0 "temp" '(9.3 -3.5 0.0) "TS" "23.0"        acAlignmentLeft) 
      ) 
    ) 
  ) 
  (defun _insert (point date n i len d / blkref tag atts) 
    (setq blkref (vla-insertblock 
                   (vla-get-modelspace 
                     (vla-get-activedocument (vlax-get-acad-object)) 
                   ) 
                   (vlax-3d-point point) 
                   "gk_x" 
                   1.0 
                   1.0 
                   1.0 
                   0.0 
                 ) 
    ) 
    (setq atts (vlax-invoke blkref 'getattributes)) 
    (foreach att atts 
      (setq tag (strcase (vla-get-tagstring att))) 
      (cond 
        ((eq tag "DATE") 
         (vla-put-textstring att date) 
        ) 
        ((eq tag "N") (vla-put-textstring att n)) 
        ((eq tag "INDEX") (vla-put-textstring att i)) 
        ((eq tag "LENGTH") (vla-put-textstring att len)) 
        ((eq tag "TS") (vla-put-textstring att (strcat d "%%dC"))) 
        (t) 
      ) 
    ) 
  ) 
  (defun _insertlc (p str / blkref atts tag) 
    (setq blkref (vla-insertblock 
                   (vla-get-modelspace 
                     (vla-get-activedocument (vlax-get-acad-object)) 
                   ) 
                   (vlax-3d-point p) 
                   "gk_x0" 
                   1.0 
                   1.0 
                   1.0 
                   0.0 
                 ) 
    ) 
    (setq atts (vlax-invoke blkref 'getattributes)) 
    (foreach att atts 
      (setq tag (strcase (vla-get-tagstring att))) 
      (if (eq tag "LC") 
        (vla-put-textstring att str) 
      ) 
 
    ) 
  ) 
 
  (defun XD::Excel:getActiveUsedRangeValues 
         (/ _usedrangevalued excel sh lst) 
    (defun _usedrangevalue (sh) 
      (mapcar 
        (function (lambda (x) (mapcar 'vlax-variant-value x))) 
        (vlax-safearray->list 
          (variant-value 
            (vlax-get-property (vlax-get sh 'usedrange) 'value) 
          ) 
        ) 
      ) 
    ) 
    (if        (setq excel (vlax-get-or-create-object "Excel.Application")) 
      (progn 
        (setq sh  (vlax-get excel 'activesheet) 
              lst (_usedrangevalue sh) 
        ) 
        (vlax-release-object excel) 
      ) 
    ) 
    lst 
  ) 
  (vl-load-com) 
 
  (if (and (setq p (getpoint "\nstartpoint: ")) 
           (setq lst (cdr (XD::EXCEL:GETACTIVEUSEDRANGEVALUES))) 
           (setq lst 
                  (vl-remove 
                    nil 
                    (mapcar 
                      (function 
                        (lambda        (a) 
                          (if 
                            (vl-some 
                              (function        (lambda (b) (or (equal b "") (null b))) 
                              ) 
                              a 
                            ) 
                             nil 
                             a 
                          ) 
                        ) 
                      ) 
                      lst 
                    ) 
                  ) 
           ) 
           (> (length lst) 1) 
      ) 
    (progn 
      (setq bp p) 
      (_mkfont) 
      (_mkblock) 
      (_mkblocklc) 
      (foreach x lst 
        (mapcar 'set '(str sl el len date tmp) x) 
        (_insertlc p (strcat "+" (rtos sl 2 3))) 
        (_insert (mapcar '+ p (list (* 0.05 len) 0. 0.)) 
                 date 
                 (substr str 1 2) 
                 (substr str 3) 
                 (rtos len 2 2) 
                 (rtos tmp 2 1) 
        ) 
        (setq p (polar p 0. (* 0.1 len))) 
      ) 
      (mapcar 'set '(str sl el len date tmp) (last lst)) 
      (_insertlc p (strcat "+" (rtos el 2 3))) 
      (setq pl (xdrx_polyline_make bp p)) 
      (xdrx_polyline_setconstantwidth pl 0.5) 
    ) 
  ) 
  (princ) 
)

Lisphk · 发表于 2019-1-14 17:58:21

st788796 发表于 2019-1-14 16:02
仅对提供的样图，没有加入绘制粗线

大师，为什么
(setq excel (vlax-get-or-create-object "Excel.Application"))
这个有返回值

但是

(vlax-get excel 'activesheet) 这个返回NIL呢？

EXCEL 2016版本，系统WIN10 64位，CAD 2012 64位

搜狗截图20190114175725.png

st788796 · 发表于 2019-1-15 08:56:54

Lisphk 发表于 2019-1-14 17:58
大师，为什么
(setq excel (vlax-get-or-create-object "Excel.Application"))
这个有返回值

没有这个系统环境，你检查一下
1 确保 excel 有文档
2 在 acad 中使用 (vlax-dump-object excel t) 看看
3 换 (vlax-get-property excel 'activesheet) 试试有没有返回值

立冬 · 发表于 2019-1-15 17:17:43

st788796 发表于 2019-1-14 16:02
更新：

增加粗线绘制，里程加上 "+"

首先表示非常感谢！但现在还有个小问题，麻烦帮修改下！如下图：

Lisphk · 发表于 2019-1-15 17:34:51

st788796 发表于 2019-1-15 08:56
没有这个系统环境，你检查一下
1 确保 excel 有文档
2 在 acad 中使用 (vlax-dump-object excel t) 看 ...

谢谢大师回复
EXCEL已经打开

看下截图
搜狗截图20190115173137.png

账号		自动登录	找回密码
密码			立即注册

[求助] CAD与EXCEL相互转化并自动画图

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。