[LISP程序]：如何获取LWPOLYLINE的第二点坐标？

Hossman

发现LWPOLYLINE实体中第一点和第二点坐标的group code都是10。不知道有什么办法能够获得第二点的坐标。谢谢

lsjjm

论坛里有许多求多义线顶点的程序，　搜索一下．

stone0030

可以检验每一个原子，只要头一位的是10的就保留，排除顺序，不就可以得到每一点的坐标了么

Free-Lancer

(setq lst (member (assoc 10 plist)));
(car (assoc 10 (cdr lst)));second point

LADESIGNER

也可以这样：
(setq enlist(entget (car en)))
(setq secondpt(cdr(assoc 10(reverse enlist))))

stone0030

5楼楼主解决的只是只有两点的多段线的问题，如果多段线有超过两点，那就不对了
4楼楼主的方法也只能找到第二点，如果在往下找第三点、第四点就麻烦了
有没有通用程序，可以把多段线的每一个点都列出来

Free-Lancer

最初由 stone0030 发布
[B]5楼楼主解决的只是只有两点的多段线的问题，如果多段线有超过两点，那就不对了
4楼楼主的方法也只能找到第二点，如果在往下找第三点、第四点就麻烦了
有没有通用程序，可以把多段线的每一个点都列出来 [/B]

找点的函数太多了

2. 
   
3. ;;不适合 3dpline
   
4. (defun getplpoints (pline / el )
   
5.   (setq        el (entget pline)
   
6.         el (vl-remove-if-not '(lambda (x) (= (car x) 10)) el)
   
7.   )
   
8.   (mapcar 'cdr el)
   
9. )

<br /> ;;不适合 3dpline<br /> (defun getplpoints (pline / el )<br />   (setq        el (entget pline)<br />         el (vl-remove-if-not '(lambda (x) (= (car x) 10)) el)<br />   )<br />   (mapcar 'cdr el)<br /> )

xyp1964

一个罗嗦的：
[php](defun c:test (/ ss i ssn retcoord n pt)
  (setvar "cmdecho" 0)
  (princ "\n选取PLINE多义线...")
  (setq ss (ssget '((0 . "*POLYLINE"))))
  (setq i 0)
  (setvar "pdmode" 33)
  (repeat (sslength ss)
    (princ (strcat "\n第" (rtos (+ i 1) 2 0) "条线数据 : "))
    (princ)
    (setq ssn (ssname ss i))
    (setq retcoord (vla-get-Coordinates (vlax-ename->vla-object ssn)))
    (setq n 0)
    (repeat
      (length (vlax-safearray->list (vlax-variant-value retcoord))
      )
       (setq pt
              (vlax-safearray-get-element (vlax-variant-value retcoord) n)
       )
       (princ "\n")
       (princ pt)
       (setq n (1+ n))
    )
    (princ)
    (princ "\n ")
    (princ)
    (setq i (+ 1 i))
  )
  (princ)
)
[/php]

LADESIGNER

AUTOLISP：
(DEFUN C:TEST (/ EN ENLIST N PL SS ZB)
  (PROMPT "\n选择要分析的多段线:")
  (SETQ SS (SSGET '((0 . "LWPOLYLINE"))))
  (SETQ        N  0
        PL '()
  )
  (REPEAT (SSLENGTH SS)
    (SETQ EN (SSNAME SS N))
    (SETQ ENLIST (ENTGET EN))
    (FOREACH X ENLIST
      (PROGN
        (IF (EQUAL (CAR X) 10)
          (SETQ PL (CONS (CDR X) PL))
        )
      )
    )

    (SETQ PL (REVERSE PL))
    (PRINC PL)
    (SETQ N (1+ N))
  )
  (PRINC)
)

xyp1964

最初由 LADESIGNER 发布
[B]AUTOLISP：
(DEFUN C:TEST (/ EN ENLIST N PL SS ZB)
  (PROMPT "\n选择要分析的多段线:")
  (SETQ SS (SSGET '((0 . "LWPOLYLINE"))))
  (SETQ        N  0
        PL '()
  )
  (REPEAT (SSLENGTH SS)
    (SETQ EN (SS... [/B]

[php]
(DEFUN C:TEST (/ EN ENLIST N PL SS ZB)
  (PROMPT "\n选择要分析的多段线:")
  (SETQ SS (SSGET '((0 . "*POLYLINE"))));;增加通配符
  (SETQ        N  0
        PL '()
  )
  (REPEAT (SSLENGTH SS)
    (SETQ EN (SSNAME SS N))
    (SETQ ENLIST (ENTGET EN))
    (FOREACH X ENLIST
      (PROGN
        (IF (EQUAL (CAR X) 10)
          (SETQ PL (CONS (CDR X) PL))
        )
      )
    )
    (SETQ PL (REVERSE PL))
    (PRINC PL)
    (SETQ N (1+ N))
  )
  (PRINC)
)[/php]
测试后无效。

lsjjm

这个简单：
(cadr  (acet-geom-vertex-list (car (entsel))))

xyp1964

acet-geom-vertex-list 不是标准CAD函数。

LADESIGNER

R14和2002都没有问题：