[日积月累]： linevertexes

eachy

2. 
   
3. (defun linevertexes (linename / linedata linevrtxlist n vrtxname)
   
4.   (cond        ((= (cdr (assoc '0 (entget linename))) "lwpolyline")
   
5.          (setq linedata (entget linename))
   
6.          (setq n 0)
   
7.          (while        (assoc 10 linedata)
   
8.            (setq linevrtxlist
   
9.                   (append linevrtxlist
   
10.                           (list (cdr (assoc 10 linedata)))
    
11.                   )
    
12.            )
    
13.            (setq linedata (vl-remove (assoc 10 linedata) linedata))
    
14.          ) ;_ end of while     linevrtxlist     )
    
15.          ((= (cdr (assoc '0 (entget linename))) "line")
    
16.            (setq linedata (entget linename))
    
17.            (list (cdr (assoc 10 linedata)) (cdr (assoc 11 linedata)))
    
18.          )
    
19.          ((= (cdr (assoc '0 (entget linename))) "polyline")
    
20.            (setq vrtxname (entnext linename))
    
21.            (while vrtxname
    
22.              (if (= (cdr (assoc '0 (entget vrtxname))) "vertex")
    
23.                (setq linevrtxlist
    
24.                       (append
    
25.                         linevrtxlist
    
26.                         (list (cdr (assoc '10 (entget vrtxname))))
    
27.                       )
    
28.                )
    
29.              ) ;_ end of if
    
30.              (setq vrtxname (entnext vrtxname))
    
31.            ) ;_ end of while     linevrtxlist
    
32.          )
    
33.         ) ;_ end of cond  ) ;_ end of defun
    
34.   )
    
35. )
    
36. ;;;- $getPointsOfPolyline
    
37. (defun $getPointsOfPolyline
    
38.        (polylineName / polylineInfo vertexName listOfPoints)
    
39.   (cond
    
40.     ((= (cdr (assoc '0 (entget polylineName))) "LWPOLYLINE")
    
41.      (setq polylineInfo (entget polylineName))
    
42.      (while (vl-position (assoc '10 polylineInfo) polylineInfo)
    
43.        (setq listOfPoints
    
44.               (cons (cdr (nth (vl-position
    
45.                                 (assoc '10 polylineInfo)
    
46.                                 polylineInfo
    
47.                               ) ;_ vl-position        polylineInfo
    
48.                          ) ;_ nth
    
49.                     ) ;_ cdr    listOfPoints
    
50.               ) ;_ cons
    
51.        ) ;_ setq
    
52.        (setq polylineInfo
    
53.               (vl-remove (assoc '10 polylineInfo) polylineInfo)
    
54.        ) ;_ setq
    
55.      ) ;_ while
    
56.     )
    
57.     ((= (cdr (assoc '0 (entget polylineName))) "POLYLINE")
    
58.      (setq vertexName (entnext polylineName))
    
59.      (while vertexName
    
60.        (if (= (cdr (assoc '0 (entget vertexName))) "VERTEX")
    
61.          (setq listOfPoints
    
62.                 (cons (cdr (assoc '10 (entget vertexName))) ;_ cdr      listOfPoints
    
63.                 ) ;_ cons
    
64.          ) ;_ setq
    
65.        ) ;_ if
    
66.        (setq vertexName (entnext vertexName))
    
67.      ) ;_ while
    
68.     )
    
69.     (T (setq listOfPoints nil))
    
70.   ) ;_ cond
    
71.   (reverse listOfPoints)
    
72. ) ;_ defun
    
73. ;;;==========================================
    
74. (defun plv ()
    
75.   (setq pl (entget (car (entsel))))
    
76.   (foreach i pl
    
77.     (if        (= (car i) 10)
    
78.       (progn (setq coord (cons (cdr i) coord)))
    
79.     )
    
80.   )
    
81. )
    
82. ;;===========================================
    
83. (apply 'append
    
84.        (mapcar '(lambda        (_list)
    
85.                   (if (= (car _list) 10)
    
86.                     (list (cdr _list))
    
87.                   )
    
88.                 )
    
89.                (entget (car (entsel "\nSelect polyline: ")))
    
90.        )
    
91. )
    
92. ;;============================================
    
93. (defun C:pol-d (/ list-vert list-point pl plv list-vert i a)
    
94.   (setq        list-vert '()
    
95.         list-point
    
96.          '()
    
97.   )
    
98.   (setq pl (car (entsel "\nSelect polyline: ")))
    
99.   (while (setq plv (entnext pl))
    
100.     (setq list-vert (cons plv list-vert)
     
101.           pl            plv
     
102.     )
     
103.   )
     
104.   (foreach i list-vert
     
105.     (setq a             (cdr (assoc 10 (entget i)))
     
106.           list-point (cons a list-point)
     
107.     )
     
108.   )
     
109.   list-point
     
110. )
     
111. ;;====================================================
     

<br /> (defun linevertexes (linename / linedata linevrtxlist n vrtxname)<br />   (cond        ((= (cdr (assoc '0 (entget linename))) "lwpolyline")<br />          (setq linedata (entget linename))<br />          (setq n 0)<br />          (while        (assoc 10 linedata)<br />            (setq linevrtxlist<br />                   (append linevrtxlist<br />                           (list (cdr (assoc 10 linedata)))<br />                   )<br />            )<br />            (setq linedata (vl-remove (assoc 10 linedata) linedata))<br />          ) ;_ end of while     linevrtxlist     )<br />          ((= (cdr (assoc '0 (entget linename))) "line")<br />            (setq linedata (entget linename))<br />            (list (cdr (assoc 10 linedata)) (cdr (assoc 11 linedata)))<br />          )<br />          ((= (cdr (assoc '0 (entget linename))) "polyline")<br />            (setq vrtxname (entnext linename))<br />            (while vrtxname<br />              (if (= (cdr (assoc '0 (entget vrtxname))) "vertex")<br />                (setq linevrtxlist<br />                       (append<br />                         linevrtxlist<br />                         (list (cdr (assoc '10 (entget vrtxname))))<br />                       )<br />                )<br />              ) ;_ end of if<br />              (setq vrtxname (entnext vrtxname))<br />            ) ;_ end of while     linevrtxlist<br />          )<br />         ) ;_ end of cond  ) ;_ end of defun<br />   )<br /> )<br /> ;;;- $getPointsOfPolyline<br /> (defun $getPointsOfPolyline<br />        (polylineName / polylineInfo vertexName listOfPoints)<br />   (cond<br />     ((= (cdr (assoc '0 (entget polylineName))) "LWPOLYLINE")<br />      (setq polylineInfo (entget polylineName))<br />      (while (vl-position (assoc '10 polylineInfo) polylineInfo)<br />        (setq listOfPoints<br />               (cons (cdr (nth (vl-position<br />                                 (assoc '10 polylineInfo)<br />                                 polylineInfo<br />                               ) ;_ vl-position        polylineInfo<br />                          ) ;_ nth<br />                     ) ;_ cdr    listOfPoints<br />               ) ;_ cons<br />        ) ;_ setq<br />        (setq polylineInfo<br />               (vl-remove (assoc '10 polylineInfo) polylineInfo)<br />        ) ;_ setq<br />      ) ;_ while<br />     )<br />     ((= (cdr (assoc '0 (entget polylineName))) "POLYLINE")<br />      (setq vertexName (entnext polylineName))<br />      (while vertexName<br />        (if (= (cdr (assoc '0 (entget vertexName))) "VERTEX")<br />          (setq listOfPoints<br />                 (cons (cdr (assoc '10 (entget vertexName))) ;_ cdr      listOfPoints<br />                 ) ;_ cons<br />          ) ;_ setq<br />        ) ;_ if<br />        (setq vertexName (entnext vertexName))<br />      ) ;_ while<br />     )<br />     (T (setq listOfPoints nil))<br />   ) ;_ cond<br />   (reverse listOfPoints)<br /> ) ;_ defun<br /> ;;;==========================================<br /> (defun plv ()<br />   (setq pl (entget (car (entsel))))<br />   (foreach i pl<br />     (if        (= (car i) 10)<br />       (progn (setq coord (cons (cdr i) coord)))<br />     )<br />   )<br /> )<br /> ;;===========================================<br /> (apply 'append<br />        (mapcar '(lambda        (_list)<br />                   (if (= (car _list) 10)<br />                     (list (cdr _list))<br />                   )<br />                 )<br />                (entget (car (entsel "\nSelect polyline: ")))<br />        )<br /> )<br /> ;;============================================<br /> (defun C:pol-d (/ list-vert list-point pl plv list-vert i a)<br />   (setq        list-vert '()<br />         list-point<br />          '()<br />   )<br />   (setq pl (car (entsel "\nSelect polyline: ")))<br />   (while (setq plv (entnext pl))<br />     (setq list-vert (cons plv list-vert)<br />           pl            plv<br />     )<br />   )<br />   (foreach i list-vert<br />     (setq a             (cdr (assoc 10 (entget i)))<br />           list-point (cons a list-point)<br />     )<br />   )<br />   list-point<br /> )<br /> ;;====================================================<br />

lsjjm

能否解释一下程序的用途? 如果只是获得直线,多义线的顶点, 是否太复杂了!?

eachy

最初由 lsjjm 发布
[B]能否解释一下程序的用途? 如果只是获得直线,多义线的顶点, 是否太复杂了!? [/B]

从别的网站看到的，顺手就贴过来了。对初学者可以学习Lisp的结构与方法。