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

Lisphk

立冬 发表于 2019-1-15 17:17
首先表示非常感谢！但现在还有个小问题，麻烦帮修改下！如下图：

把里面这句 (_insertlc p (strcat "+" (rtos sl 2 3)))

改成：

(_insertlc p (strcat "+" (substr (rtos (- sl (fix sl)) 2 3) 3) ".00")))

试试

立冬

Lisphk 发表于 2019-1-15 17:42
把里面这句 (_insertlc p (strcat "+" (rtos sl 2 3)))

改成：

还是一样，没有变化

Lisphk

立冬 发表于 2019-1-15 18:08
还是一样，没有变化

下面还有一个 (_insertlc p (strcat "+" (rtos el 2 3)))

把这个也改成

(_insertlc p (strcat "+" (substr (rtos (- el (fix el)) 2 3) 3) ".00")))

立冬

Lisphk 发表于 2019-1-15 18:15
下面还有一个 (_insertlc p (strcat "+" (rtos el 2 3)))

把这个也改成

都改了。。

Lisphk

立冬 发表于 2019-1-15 18:22
都改了。。

你用的是块，要更新才行，你把所有块都删除，删除PURGE下图形，重新生成试试
或者开张新图

立冬

Lisphk 发表于 2019-1-15 18:30
你用的是块，要更新才行，你把所有块都删除，删除PURGE下图形，重新生成试试
或者开张新图

重新开张新图也是一样。

Lisphk

立冬 发表于 2019-1-15 19:09
重新开张新图也是一样。

你确定你改好了吗？ 不可能数和以前一样的
你把你改好的代码贴上来看看

立冬

Lisphk 发表于 2019-1-15 19:16
你确定你改好了吗？ 不可能数和以前一样的
你把你改好的代码贴上来看看

(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 "+" (substr (rtos (- el (fix el)) 2 3) 3) ".00")))
        (_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 "+" (substr (rtos (- el (fix el)) 2 3) 3) ".00")))
      (setq pl (xdrx_polyline_make bp p))
      (xdrx_polyline_setconstantwidth pl 0.5)
    )
  )
  (princ)
)

立冬

Lisphk 发表于 2019-1-15 19:16
你确定你改好了吗？ 不可能数和以前一样的
你把你改好的代码贴上来看看

已调试好了，是多一个括号的事！但为什么从EXCEL表里的第三列输出的数据呢？之前是第二列啊

Lisphk

立冬 发表于 2019-1-15 20:26
已调试好了，是多一个括号的事！但为什么从EXCEL表里的第三列输出的数据呢？之前是第二列啊

你看看你改的两行代码， 里面是不一样的，你别复制一样了
一个是sl   第二个改的，里面是el

立冬

Lisphk 发表于 2019-1-15 20:38
你看看你改的两行代码， 里面是不一样的，你别复制一样了
一个是sl   第二个改的，里面是el

都怪我没看仔细！那要是+604.11，而不是+604.00呢？

Lisphk

立冬 发表于 2019-1-15 20:51
都怪我没看仔细！那要是+604.11，而不是+604.00呢？

你EXCEL表里面不都是三位小数吗？ 有5位的数据？

如果要5位，我看你是用了XDRX API了吧，用了就下面改
分别改：
(_insertlc p (strcat "+" (xdrx_string_insert (substr (rtos (- sl (fix sl)) 2 5) 3)  3 ".")))
...
(_insertlc p (strcat "+" (xdrx_string_insert (substr (rtos (- el (fix el)) 2 5) 3)  3 ".")))

立冬

Lisphk 发表于 2019-1-15 21:09
你EXCEL表里面不都是三位小数吗？ 有5位的数据？

如果要5位，我看你是用了XDRX API了吧，用了就下面改 ...

极少数需要5位数，大部分都是3位数
来自: 微社区

立冬

要是有没用XDRX API的呢？
来自: 微社区

newer

立冬 发表于 2019-1-15 21:44
要是有没用XDRX API的呢？

(xdrx_string_insert (substr (rtos (- sl (fix sl)) 2 5) 3)  3 ".")

这句代码的作用是在5位字符串第三位插入个小数点
这个 (substr (rtos (- sl (fix sl)) 2 5) 3) 的结果可能是345.54561 的 "54561"

你搜索下论坛，看看怎么能在5位字符串第三位加个小数点，自己学点简单的代码，会让你工作受益的。