[原创]：cad点坐标生成数据文件，用于计算输入等

hejian

拾取Cad点坐标生成数据文件，用于计算输入等，例如ANSYS， sap，桥梁博士等

hsb-hy

怎么没有生成坐标数据文件啊？楼主是不是上传错了？

alwaysbin

这个程序是在d盘根目录下生成一个node.txt文件，的确是可以用的。
小程序，但很实用，不错。

hsb-hy

楼主你好，希望你能够修改一下程序，可以指定坐标文件存储路径和名称！

xyp1964

程序功能：多义线顶点序号及坐标标注，可输出坐标数据到文本文件。
[php]
(load "xyp_lib")
;|
加载通用函数
如果已经下载xyp_lib并放到搜索路径下可以不再下载!
下载地址：http://www.xdcad.net/forum/showthread.php?s=&threadid=325268
如果已在acad.lsp中添加了(load "xyp_lib")，可以直接运行下面的程序。
|;


;;----------------------------------------------------------------------
;|
;;;功能 : 多义线顶点序号及坐标标注，可输出坐标数据到文本文件。
适用于 POLYLINE 及 LWPOLYLINE 图元 <lmf97231>
多义线编号--起始点随意选
在对管线（多义线）用LISP程序进行自动编号和座标计算时，有时需要编号顺时针递增，
有时又需要编号逆时针递增，在选取多义线时，通过选取点来确定编号方向，也就是说当
选取左半部分时从左往右开始，选取右半部分时从右往左开始。
2005.02.26 根据<xxming>的要求，修改标注闭合多义线存在的问题
2005.04.29 增加输出坐标数据到文本文件功能
|;
(defun c:test065 ()
  (cmdla0)
  (jzhz)
  (setq        tx1 (ukword 1 "1 2" "\n确定顶点顺序 : 1-正向/2-反向" tx1)
        tx2 (ukword 1 "Y N" "\n是否输出顶点坐标数据：Y-是/N-否" tx2)
  )
  (if (= tx2 "Y")
    (progn
      (setq ffn        (getfiled "\n保存的坐标文件" "坐标" "txt" 1)
            ff        (open ffn "w")
      )
    )
  )
  (command ".undo" "BE")
  (while (setq s1 (entsel "\n\t选择对象<退出> : "))
    (if        (or (= (dxf 0 (entget (car s1))) "POLYLINE")
            (= (dxf 0 (entget (car s1))) "LWPOLYLINE")
        )
      (progn
        (setq eobj (vlax-ename->vla-object (car s1))
              i           -1
        )
        (if (= tx1 "1")                        ;正向
          (progn
            (while
              (setq
                pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i)))
              )
               (princ)
            )
            (if        (= (dxf 70 (entget (car s1))) 1)
              (setq n (- i 1))
              (setq n i)
            )
            (setq i -1)
            (repeat n
              (setq
                pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i)))
              )
              (mkla "坐标编号" 1)
              (command "text"
                       "j"
                       "mr"
                       (polar pt0 (* pi 0.75) (* sc 200))
                       (* sc 400)
                       "0"
                       (rtos (+ 1 i) 2 0)
              )
              (mkla "坐标" 3)
              (X_zb pt0)
              (if (= tx2 "Y")
                (wr-tx pt0 ff)
              )
            )
          )
          ;;反向
          (progn
            (while
              (setq
                pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i)))
              )
               (princ)
            )
            (if        (= (dxf 70 (entget (car s1))) 1)
              (setq n (- i 1))
              (setq n i)
            )
            (setq i -1)
            (repeat n
              (setq
                pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i)))
              )
              (mkla "坐标编号" 1)
              (command "text"
                       "j"
                       "mr"
                       (polar pt0 (* pi 0.75) (* sc 200))
                       (* sc 400)
                       "0"
                       (rtos n 2 0)
              )
              (setq n (1- n))
              (mkla "坐标" 3)
              (X_zb pt0)
              (if (= tx2 "Y")
                (wr-tx pt0 ff)
              )
            )
          )
        )
      )
    )
  )
  (if (= tx2 "Y")
    (progn
      (close ff)
      (princ (strcat "\n 坐标写至=>" ffn))
    )
  )
  (command ".undo" "E")
  (cmdla1)
)
;;;
(defun wr-tx (point filename / tx)
  (setq        tx (strcat (rtos (+ 1 i) 2 0)
                   ":"
                   (rtos (car point) 2)
                   ","
                   (rtos (cadr point) 2)
           )
  )
  (write-line tx filename)
)
[/php]

tangdeyu

很有用，但我的积分不够，请发给我一份好吗？
deyutang@yahoo.com.cn

vanbo

不知道好不好用啊？:D

zhong2013

看一下，在那儿呢