Topic: x y coordinate of polyline (help with code)

[ron345SS]

i am trying to modify a running code which prints x and y coordinates of a polyline ..... suppose the x and y coordinate of a poly line is 50 , 40 and the offset  of x is 30 ..... new values to be printed will be 20 , 40 .... i tried to modify the code but i am running into error ... I JUST ADDED ONLY 3 LINES IN RED HIGHLIGHTED

Code - Auto/Visual Lisp: [Select]

1. (defun WRITE-VERTICES (NEWVLIST / XSTR YSTR ZSTR STR)
2.   (setq httt "0.3")
3.   (setq gptx (getpoint "\nBasepoint for X axis: "))
4.   (setq gpty (getpoint "\nBasepoint for Y axis: "))
5.   (setq off (getint "\nX offset: "))
6.  
7.   (foreach ITEM   NEWVLIST
8.     (setq XSTR (rtos (nth 0 ITEM) 2 3)
9.      YSTR (rtos (nth 1 ITEM) 2 3)
10.      ZSTR (rtos (nth 2 ITEM) 2 3)
11.      dff  (- (atof xstr) (off)
12.      STR  (strcat XSTR (SPACES XSTR) YSTR (SPACES YSTR) ZSTR) ;_ strcat
13.     )               ; setq
14.                ;      (write-line STR F1)
15.  
16.  
17.  
18.   (command "text"
19.         (list (+ (atof xstr) (/ (atof httt) 2.0)) (cadr gptx))
20.         httt
21.         "0"
22.         (strcat  dff)
23.     )
24.     (command "text"
25.         (list (+ (atof xstr) (/ (atof httt) 2.0)) (cadr gpty))
26.         httt
27.         "0"
28.         (strcat ystr)
29.     )

the whole working code is

Code - Auto/Visual Lisp: [Select]

1. (defun ERR (S)
2.   (if (= S "Function cancelled")
3.     (princ "\nVERTEXT - cancelled: ")
4.     (progn (princ "\nVERTEXT - Error: ") (princ S) (terpri))
5.   )
6.   (RESETTING)
7.   (princ "SYSTEM VARIABLES have been reset\n")
8.   (princ)
9. )
10. (defun SETV (SYSTVAR NEWVAL)
11.   (setq X (read (strcat SYSTVAR "1")))
12.   (set X (getvar SYSTVAR))
13.   (setvar SYSTVAR NEWVAL)
14. )
15. (defun SETTING ()
16.   (setq OERR *ERROR*)
17.   (setq *ERROR* ERR)
18.   (SETV "CMDECHO" 0)
19.   (SETV "BLIPMODE" 0)
20. )
21. (defun RSETV (SYSTVAR)
22.   (setq X (read (strcat SYSTVAR "1")))
23.   (setvar SYSTVAR (eval X))
24. )
25.  
26. (defun RESETTING ()
27.   (RSETV "CMDECHO")
28.   (RSETV "BLIPMODE")
29.   (setq *ERROR* OERR)
30. )
31.  
32.  
33. (defun DXF (CODE ENAME) (cdr (assoc CODE (entget ENAME)))) ; dxf
34.  
35. (defun VERTEXT (/ EN VLIST)
36.   (setq EN (GET-EN))
37.   (if (= (DXF 0 EN) "LWPOLYLINE")
38.     (setq VLIST (GET-LWVLIST EN))
39.     (setq VLIST (GET-PLVLIST EN))
40.   )
41.   (WRITE-IT VLIST EN)
42. )
43.  
44. (defun GET-EN (/ NO-ENT EN MSG1 MSG2)
45.   (setq NO-ENT 1
46.         EN     NIL
47.         MSG1   "\nSelect a polyline: "
48.         MSG2   "\nNo polyline selected, try again."
49.   )                                     ; setq
50.   (while NO-ENT
51.     (setq EN (car (entsel MSG1)))
52.     (if (and EN
53.              (or (= (DXF 0 EN) "LWPOLYLINE") (= (DXF 0 EN) "POLYLINE"))
54.                                         ; or
55.         )                               ; and
56.       (progn (setq NO-ENT NIL))         ; progn
57.       (prompt MSG2)
58.     )                                   ; if
59.   )                                     ; while
60.   EN
61. )                                       ; get-en
62.  
63. (defun GET-LWVLIST (EN / ELIST NUM-VERT VLIST)
64.   (setq ELIST    (entget EN)
65.         NUM-VERT (cdr (assoc 90 ELIST))
66.         ELIST    (member (assoc 10 ELIST) ELIST)
67.         VLIST    NIL
68.   )                                     ; setq
69.   (repeat NUM-VERT
70.     (setq VLIST (append VLIST (list (cdr (assoc 10 ELIST)))) ; append
71.     )                                   ; setq
72.     (setq ELIST (cdr ELIST)
73.           ELIST (member (assoc 10 ELIST) ELIST)
74.     )                                   ; setq
75.   )                                     ; repeat
76.   VLIST
77. )                                       ; get-lwvlist
78.  
79. (defun GET-PLVLIST (EN / VLIST)
80.   (setq VLIST NIL
81.         EN    (entnext EN)
82.   )                                     ; setq
83.   (while (/= "SEQEND" (DXF 0 EN))
84.     (setq VLIST (append VLIST (list (DXF 10 EN))))
85.     (setq EN (entnext EN))
86.   )                                     ; while
87.   VLIST
88. )                                       ; get-plvlist
89.  
90. (defun WRITE-IT (VLST EN / NEWVLIST MSG3 FNAME)
91.   (setq NEWVLIST (mapcar '(lambda (X) (trans X EN 0)) ;_ lambda
92.                          VLST
93.                  ) ;_ mapcar
94.         MSG3     "Polyline vertex file"
95.                                         ;FNAME    (getfiled MSG3 "" "txt" 1)
96.         F1       (open "FNAME" "w")
97.   )                                     ; setq
98.   (WRITE-HEADER)
99.   (WRITE-VERTICES NEWVLIST)
100.   (setq F1 (close F1))
101. ) ;_ write-it
102.  
103. (defun WRITE-HEADER (/ STR)
104.   (setq STR "        POLYLINE VERTEX POINTS")
105.   (write-line STR F1)
106.   (setq STR (strcat "  X            " "  Y            " "  Z") ;_ strcat
107.   ) ;_ setq
108.   (write-line STR F1)
109. ) ;_ write-header
110.  
111.  
112. (defun WRITE-VERTICES (NEWVLIST / XSTR YSTR ZSTR STR)
113.   (setq httt "0.15")
114.   (setq gptx (getpoint "\nBasepoint for X axis: "))
115.   (setq gpty (getpoint "\nBasepoint for Y axis: "))
116.  
117.  
118.  
119.  
120.   (foreach ITEM NEWVLIST
121.     (setq XSTR (rtos (nth 0 ITEM) 2 3)
122.           YSTR (rtos (nth 1 ITEM) 2 3)
123.           ZSTR (rtos (nth 2 ITEM) 2 3)
124.          
125.           STR  (strcat XSTR (SPACES XSTR) YSTR (SPACES YSTR) ZSTR)
126.                                         ;_ strcat
127.     )                                   ; setq
128.                                         ;      (write-line STR F1)
129.  
130.  
131.  
132.     (command "text"
133.              (list (+ (atof xstr) (/ (atof httt) 2.0)) (cadr gptx))
134.              httt
135.              "90"
136.              (strcat xstr)
137.     )
138.     (command "text"
139.              (list (+ (atof xstr) (/ (atof httt) 2.0)) (cadr gpty))
140.              httt
141.              "90"
142.              (strcat ystr)
143.     )
144.  
145.   )                                     ; foreach
146.  
147. )                                       ; write-vertices
148.  
149.  
150. (defun SPACES (STR / FIELD NUM CHAR SPACE)
151.   (setq FIELD 15
152.         NUM   (- FIELD (strlen STR))
153.         CHAR  " "
154.         SPACE ""
155.   ) ;_ setq
156.   (repeat NUM (setq SPACE (strcat SPACE CHAR))) ;_ repeat
157. ) ;_ spaces
158.  
159. (defun C:vv () (SETTING) (VERTEXT) (RESETTING) (princ)) ; c:nsl

EDIT (John): Added code tags and highlights.

[JohnK]

Welcome to the Swamp.
Please take a moment to read up on how to proplerly display your code; this makes it easier for other people to read and thus help you.
https://www.theswamp.org/index.php?topic=48309.0

[BIGAL]

This may be helpful.

Code: [Select]

(setq plent (entsel "\nPick rectang"))
(if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))))
(princ co-ord)