跪求！ 谢谢各位了

ngl_123

请问各位大侠谁更给我提供一个可以提取一条线上各节点坐标的lisp程序代码？？？

先在这里说声谢谢了！

phoenixdjq

用群码找就可以了

看看帮助！

ngl_123

我是菜鸟   请问能说的再详细一些吗？

phoenixdjq

你是为了学习还是为了帮助工作

如果是学习的话，还是建议你多看看书，一本书一定要从头开始看

如果是需要这个程序的话，我帮你做一个

ngl_123

真的是非常感谢您   是这样的 

现在我工作需要用这样一个程序，我也想学习，两者都有！   如果可以您能先帮我写一段关键的代码吗？

zml84

(vl-load-com)

;;;==============================

(defun  C:TT  (/  SS)
    (princ  "\n删除PL线上相邻的重复点，假设只有直线片段")
    (if (setq  SS  (ssget  '((0  .  "LWPOLYLINE"))))
 (progn     (setq  I  0)
     (repeat  (sslength  SS)
  (setq  ENT  (entget  (ssname  SS  I)))
  ;;得到顶点表
  (setq  LST_PT  '())
  (foreach  N  ENT
      (if (=  (car  N)  10)
   (setq  LST_PT  (cons  (cdr  N)  LST_PT))
      )
  )................

全文在：http://zml84.blog.sohu.com/83814491.html

phoenixdjq

声明一下：

这个程序是别人做的，你可以根据这个来进行修改，或者你说明具体的要求，我想肯定有人帮你改的

(defun liang(k pt3 r)
  (setq xx(car k))
  (setq yy(cadr k))
  (setq x1(car pt3))
  (setq y1(cadr pt3))
  (setq x1(+ 28 x1))
  (setq pe1(list x1 y1))
  (setq xj( - (car pt3) 10))
  (setq pe2(list xj y1))
  (command "text" pe2 3 0 r)
  (command "text" pt3 3 0 (rtos xx))
  (command "text" pe1 3 0 (rtos yy))
  )
 

(defun c:biaoge()
  (setq key 10 i 0 j 0)
  (setq obj (car (entsel "\nselect a Polyline: ")))
  (setq ent (entget obj))
  (setq pt(getpoint"\n坐标册放在："))
  (setq x(car pt))
  (setq y(cadr pt))
  (setq yn y)
  (setq x4(- x 10))
  (setq pt4(list x4 y))
  (setq x1(+ 18 x4))
  (setq pt1(list x1 y))
  (setq x2(+ 46 x4))
  (setq pt2(list x2 y))
  (setq y9(+ y 7))
  (setq pt9(list x4 y9))
  (command "text" pt9 4 0 "界址点坐标册")
  (command "text" pt4 4 0 "点号")
  (command "text" pt1 4 0 "X坐标")
  (command "text" pt2 4 0 "Y坐标")
 
  (foreach xy ent
    (if (eq (car xy) key )
      (progn
 (setq j (1+ j))
 (setq pe1 (cdr xy))
 (command "text" pe1 3 0 j)
 (setq yn (- yn 10))
 (setq pt3 (list x yn))
 (liang pe1 pt3 j )
 )
      )
    )
  (setq x5(- x4 3.220))
  (setq y5(+ y 5.2259))
  (setq pt5(list x5 y5))
  (setq x6(+ x5 69.1817))
  (setq pt6(list x6 y5))
  (command "LINE" pt5 pt6 "")
  (setq a(entlast))
  (command "array" a "" "r" (+ j 2) 1 -10)
  (setq y7(- y5 10))
  (setq pt7(list x5 y7))
  (command "LINE" pt5 pt7 "")
  (setq a(entlast))
  (command "array" a "" "r"  (+ j 1) 2 -10  11)
  (setq pt8(list x6 y7))
  (command "LINE" pt6 pt8 "")
  (setq a(entlast))
  (command "array" a "" "r"  (+ j 1) 2 -10  -30)
  )