能把Excel中的XYZ坐标导入到CAD，同时标注出来

小康_U8y3Y

麻烦大神帮忙弄个程序，第一种情况
1.能把Excel中的XYZ坐标导入到CAD，同时自动全部标注出来。标注的字体高度能设置，小数点位数能设置，或者与Excel中一致也行。

如果标注的样式能设置最好

第二种情况
1.如果已经有现成的坐标了，直接利用插件点击坐标点出来XYZ坐标



上次在论坛看到一个这样的程序  可是没有办法用出现错误，实参太少

(defun xd::clipboard:CSV->list ()
  (if (setq str (xd::doc:getclipboardtext))
    (mapcar '(lambda (x) (xdrx_string_regexps "[^\\t\\,\\:\\s]+" x))
            (xdrx_string_split str "\r\n")
    )
  )
)
(defun xd::coords:make (base direction len txt txtheight zflag)
  (if (not (xdrx_object_get "mleaderstyle" "zbbz"))
    (progn (setq mls (xdrx_mleader_makestyle "zbbz"))
           (xdrx_setpropertyvalue mls "dogleglength" 2.0)
           (xdrx_setpropertyvalue mls "TextAttachmentType" 6)
           (xdrx_setpropertyvalue mls "LandingGap" 0.0)
           (xdrx_setpropertyvalue mls "Scale" 1.0)
           (xdrx_getpropertyvalue mls "ArrowSymbolId" "_None")
           (setvar "cmleaderstyle" "zbbz")
    )
  )
  (setq z (caddr txt)
        txt ($xdob_text_format (list (car txt)(cadr txt)))
        p2 (mapcar
             '+
             base
             (xdrx_vector_product (xdrx_vector_normalize direction) len)
           )
        ml (xdrx_mleader_make
             base
             p2
             (strcat "X=" (cadr txt) "\r\nY=" (car txt) (if (and zflag z) (strcat "\r\nZ=" z) ""))
             txtheight
             2.0
           )
  )
  (setq mTxt (xdrx_getpropertyvalue ml "mtext" t))
  (xdrx_setpropertyvalue
    mTxt
    "textheight"
    (* (xd::var:getscaleratio) txtheight)
    "LineSpacingFactor"
    0.8
  )
  (xdrx_setpropertyvalue
    ml "mtext" mtxt "ArrowSymbolId" "_None"
   )
  (xdrx_entity_delete mtxt)
  ml
)
(defun c:tt ()
  (defun myerr (msg)
    (xdrx_pointmonitor)
    (xdrx_sysvar_pop)
    (setq *error* olderr)
    (princ)
  )
  (if (or (and (setq str (xd::excel:readselection))
               (setq str (cdar str))
               (setq str
                      (mapcar '(lambda (x) (mapcar '(lambda (y) (rtos y 2 4)) x))
                              str
                      )
               )
          )
          (setq str (xd::clipboard:CSV->list))
      )
    (progn
      (xd::doc:checkacadversion '>= "2008" "")
      (xdrx_begin)
      (setq olderr  *error*
            *error* myerr
      )
      (if (not #xd_var_global_txth)
        (setq #xd_var_global_txth 3.0)
      )
      (if (setq
            val (getreal
                  (xdrx_prompt "\n文字高度<" #xd_var_global_txth ">:" t)
                )
          )
        (setq #xd_var_global_txth val)
      )
      (if (not #xd_var_global_mleader_length)
        (setq #xd_var_global_mleader_length 30.0)
      )
      (if (setq val (getreal (xdrx_prompt
                               "\n引线长度<"
                               #xd_var_global_mleader_length
                               ">:"
                               t
                             )
                    )
          )
        (setq #xd_var_global_mleader_length val)
      )
      (xdrx_sysvar_push
        '("cmleaderstyle" "zbbz")
        '("dimzin" 0)
      )
      (xd::text:init 1)
      (mapcar '(lambda (x)
                 (setq base
                        (list (atof (car x)) (atof (cadr x)) (atof (caddr x)))
                 )
                 (xd::coords:make
                   base '(1 -1 0.) #xd_var_global_mleader_length x
                   #xd_var_global_txth t
                  )
               )
              str
      )
      (xdrx_prompt "\n成功导入并绘制 " (length str) " 个坐标.")
    )
    (progn
      (xdrx_prompt "\nEXCEL没有选择数据或剪切板上无有效数据.")
    )
  )
  (xdrx_end)
  (princ)
)







下面这个程序又无法设置小数的精度，能不能修改下可以设置小数精度，谢谢

(defun C:XYZ (/ OSNAP PNT1 P1X P1Y P1Z P STDX STDY STDZ XCOORD YCOORD ZCOORD PTXT )
    (setvar "ORTHOMODE" 0)
   ; (setq OSNAP (getvar "OSMODE"))
   ; (command "setvar" "osmode" "1")   
    (command "setvar" "luprec" "0")
    (prompt "NOTE!!! Coords. & leader drawn per current dimstyle; precision per UNITS... ")
             (setq dst (getvar "dimstyle"))
  (command "_.-DIMSTYLE" "_Restore" dst)
    (setq PNT1 (getpoint "\n请选择标注点: "))
    (setq P1X (car pnt1))
    (setq P1Y (cadr pnt1))
    (setq P1Z (caddr pnt1))
    (setq P (getvar "LUPREC"))
    (setq STDX (rtos P1X 2 P))
    (setq STDY (rtos P1Y 2 P))
    (setq STDZ (rtos P1Z 2 P))
    (setq XCOORD (strcat "X：" STDX ))
    (setq YCOORD (strcat "Y：" STDY ))
    (setq ZCOORD (strcat "Z：" STDZ ))
    (setq PTXT (getpoint"\n请选择标注位置: "))
    (command "LEADER" PNT1 PTXT "" XCOORD YCOORD ZCOORD "")
   ; (command "SETVAR" "osmode" OSNAP)
    (command "setvar" "luprec" "4")
(princ)
)

newer

试试，根据你EXCEL选择的坐标范围，生成POLYLINE

1. (defun c:tt ()
   
2.   (defun xd::list:ispoint (x / v)
   
3.     (and (= (type x) 'list)
   
4.          (or (= (length x) 2) (= (length x) 3))
   
5.          (xd::vla:apply * x)
   
6.          (setq v (length x))
   
7.     )
   
8.     v
   
9.   )
   
10.   (xdrx-begin)
    
11.   (if (and (setq info (car (xd::excel:readselection)))
    
12.            (> (length info) 2))
    
13.     (progn (xdrx-initget "Y N")
    
14.            (setq yn (xdrx-yesorno "\nX,Y是否互换" 0))
    
15.            (if (= yn 1)
    
16.              (setq v (mapcar '(lambda (x)
    
17.                                 (if (setq v (xd::list:ispoint x))
    
18.                                   (list        (cadr x)
    
19.                                         (car x)
    
20.                                         (cond ((= v 2) 0.0)
    
21.                                               (t (last x))
    
22.                                         )
    
23.                                   )
    
24.                                   nil
    
25.                                 )
    
26.                               )
    
27.                              (car info)
    
28.                      )
    
29.              )
    
30.              (setq v (mapcar '(lambda (x)
    
31.                                 (if (setq v (xd::list:ispoint x))
    
32.                                   (list        (car x)
    
33.                                         (cadr x)
    
34.                                         (cond ((= v 2) 0.0)
    
35.                                               (t (last x))
    
36.                                         )
    
37.                                   )
    
38.                                   nil
    
39.                                 )
    
40.                               )
    
41.                              (car info)
    
42.                      )
    
43.              )
    
44.            )
    
45.            (setq v (vl-remove nil v))
    
46.            (xdrx-polyline-make v)
    
47.            (if (or (equal (car v) (last v) 1e-4)
    
48.                    (not (xdrx-initget "Y N"))
    
49.                    (= (xdrx-yesorno "\n是否闭合" 1) 1)
    
50.                )
    
51.              (xdrx-curve-setclosed (entlast) t)
    
52.            )
    
53.     )
    
54.     (xdrx-prompt "\nEXCEL中没有选择坐标范围或数值非法.生成失败！")
    
55.   )
    
56.   (xdrx-end)
    
57.   (princ)
    
58. )
    
59. 
    

(defun c:tt ()<br />   (defun xd::list:ispoint (x / v)<br />     (and (= (type x) 'list)<br />          (or (= (length x) 2) (= (length x) 3))<br />          (xd::vla:apply * x)<br />          (setq v (length x))<br />     )<br />     v<br />   )<br />   (xdrx-begin)<br />   (if (and (setq info (car (xd::excel:readselection)))<br />            (> (length info) 2))<br />     (progn (xdrx-initget "Y N")<br />            (setq yn (xdrx-yesorno "\nX,Y是否互换" 0))<br />            (if (= yn 1)<br />              (setq v (mapcar '(lambda (x)<br />                                 (if (setq v (xd::list:ispoint x))<br />                                   (list        (cadr x)<br />                                         (car x)<br />                                         (cond ((= v 2) 0.0)<br />                                               (t (last x))<br />                                         )<br />                                   )<br />                                   nil<br />                                 )<br />                               )<br />                              (car info)<br />                      )<br />              )<br />              (setq v (mapcar '(lambda (x)<br />                                 (if (setq v (xd::list:ispoint x))<br />                                   (list        (car x)<br />                                         (cadr x)<br />                                         (cond ((= v 2) 0.0)<br />                                               (t (last x))<br />                                         )<br />                                   )<br />                                   nil<br />                                 )<br />                               )<br />                              (car info)<br />                      )<br />              )<br />            )<br />            (setq v (vl-remove nil v))<br />            (xdrx-polyline-make v)<br />            (if (or (equal (car v) (last v) 1e-4)<br />                    (not (xdrx-initget "Y N"))<br />                    (= (xdrx-yesorno "\n是否闭合" 1) 1)<br />                )<br />              (xdrx-curve-setclosed (entlast) t)<br />            )<br />     )<br />     (xdrx-prompt "\nEXCEL中没有选择坐标范围或数值非法.生成失败！")<br />   )<br />   (xdrx-end)<br />   (princ)<br /> )<br /> <br />

小康_U8y3Y

好像还是不行啊   提示 实参太少   而且只是生成POLYLINE，Z坐标好像没有选择。也没有生成XYZ坐标啊

newer

小康_U8y3Y 发表于 2020-4-21 22:45
好像还是不行啊   提示 实参太少   而且只是生成POLYLINE，Z坐标好像没有选择。也没有生成XYZ坐标啊

生成多段线后，去论坛找其他工具，标注各种坐标，坐标表
工具要组合用

如果有问题，去下载最新的XDRX API或者晓东工具箱，你的图是去年早期的工具箱了。

王鹏_pBZlo

那个你说不能设小数精度的，你先用units命令设置好精度就可以，或者用例如(setvar "LUPREC" 2)可设为精度为小数点后2位，你试试看