hphkjz 发表于 2018-3-16 16:55:54

坐标和高程标注

哪位大哥能帮小弟个忙，我在excel里面已经分列编辑出多个点的坐标XYZ了，如何能够一次性在CAD图上根据坐标画出点来，并且标注上坐标和高程

newer 发表于 2018-3-16 17:08:16

首先，截取EXCEL和DWG标注完毕的图像贴上来。
其次，上传EXCEL和DWG文件供测试用。

hphkjz 发表于 2018-3-16 17:23:03

newer 发表于 2018-3-16 17:08


大哥，我已经上传上来了

Lispboy 发表于 2018-3-19 15:45:45

试试



程序可以读两种数据：
1、EXCEL选择的区域
2、拷贝到剪切板的数据（逗号，分号，空格，制表符分割的三列数据）

(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)
)




小康_U8y3Y 发表于 2020-4-21 17:22:15

提示 实参太少什么意思

小康_U8y3Y 发表于 2024-6-26 10:35:54

请问老师出现这个问题怎么解决，谢谢

pmq 发表于 2024-7-15 14:45:01



这个插件可以满足要求
CAD加载NetLoad DLL
输入命令 Sur

pmq 发表于 2024-7-15 14:59:17


小康_U8y3Y 发表于 2024-7-23 08:12:31

pmq 发表于 2024-7-15 14:59


出现了一堆警告，加载不上呢
页: [1]
查看完整版本: 坐标和高程标注