Community
@ni-ramir wrote:
Hi Kent. Thanks, it worked. I didn't have the folder c:/Temp/ created. I got one more question. If I have the polylines already named, how can I make the extraction with those names? (For example, street names, or park names that are set to the areas previously).
Are the names "attached" in some way to the Polylines that define the areas, or are they just Text entities, presumably inside or near the Polylines?
Kent Cooper, AIA 
@ni-ramir wrote:
With your lisp, after exporting the data, I modify the names that are given to the areas of the polylines (Area 1, Area 2, etc. to 22nd ST, Park NR, etc.). It would be really greta if I could export the data again with the new names edited by me.
The following does that, in limited testing. It does require that you edit the content of all the area labels you want to within the one text-editing command that it calls up, inside the routine. It leaves the original file [with areas called "Area1" etc.], and makes an additional file with a "2" on the end of the otherwise-same file name, imposing the changed area label content on each appropriate line.
(defun C:PSL ; = Polyline Segment Listing
(/ file ss plinc pl verts seginc txtElist txtClist file1 file2 txtline area# txtent)
(setq
file (open (strcat "C:/temp/" (substr (getvar 'dwgname) 1 (- (strlen (getvar 'dwgname)) 4)) "-PlSegs.txt") "w")
;; YOUR FILE PATH AND NAMING STANDARD --^
ss (ssget '((0 . "LWPOLYLINE")))
plinc -1
); setq
(write-line (strcat (getvar 'dwgname) " Polyline Segments:") file); [optional]
(write-line "AREA SEG. START X START Y END X END Y" file)
(if ss
(repeat (sslength ss)
(setq
pl (ssname ss (setq plinc (1+ plinc)))
verts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget pl)))
seginc 0
); setq
(repeat (1- (length verts))
(write-line
(strcat
"Area" (itoa (1+ plinc)) " " (itoa (1+ seginc)) " "
(rtos (car (nth seginc verts)) 2 4) " " (rtos (cadr (nth seginc verts)) 2 4) " "
(rtos (car (nth (setq seginc (1+ seginc)) verts)) 2 4) " " (rtos (cadr (nth seginc verts)) 2 4)
); strcat
file
); write-line
); repeat
(if (vlax-curve-isClosed pl)
(write-line
(strcat
"Area" (itoa (1+ plinc)) " " (itoa (1+ seginc)) " "
(rtos (car (last verts)) 2 4) " " (rtos (cadr (last verts)) 2 4) " "
(rtos (car (nth 0 verts)) 2 4) " " (rtos (cadr (nth 0 verts)) 2 4)
); strcat
file
); write-line
); if [closed]
(vla-getboundingbox (vlax-ename->vla-object PL) 'minpt 'maxpt)
(command "_.text" "_style" "ROMANS" "mc" "_none" ;;; <-- YOUR STYLE NAME
(mapcar '/ (mapcar '+ (vlax-safearray->list minpt) (vlax-safearray->list maxpt)) '(2 2 2))
1.0 0 (setq txt (strcat "Area" (itoa (1+ plinc))));;; <-- YOUR HEIGHT at beginning [omit for fixed-height Style]
); command
(setq
txtElist (cons (entlast) txtElist); Text entity
txtClist (cons txt txtClist); its text content
); setq
); repeat
); if
(close file)
(command "_.ddedit") (while (> (getvar 'cmdactive) 0) (command pause)); change Text label contents
(setq
file1 (open (strcat "C:/temp/" (substr (getvar 'dwgname) 1 (- (strlen (getvar 'dwgname)) 4)) "-PlSegs.txt") "r")
file2 (open (strcat "C:/temp/" (substr (getvar 'dwgname) 1 (- (strlen (getvar 'dwgname)) 4)) "-PlSegs2.txt") "w")
;; YOUR FILE PATH AND NAMING STANDARD --^ [both lines]
); setq
(while (setq txtline (read-line file1))
(if (wcmatch (substr txtline 1 5) "Area#"); after initial two lines
(setq
area# (substr txtline 1 (vl-string-search " " txtline)); "Area" plus integer [one or more digits]
txtent (nth (vl-position area# txtClist) txtElist); the Text label entity
txtline (vl-string-subst (cdr (assoc 1 (entget txtent))) area# txtline); replace designator with its current content
); setq
); if
(write-line txtline file2); put revised line into other file
); while
(close file1)
(close file2)
(princ)
); defun
Kent Cooper, AIA
![Autodesk Design & Make Report](https://forums.autodesk.com/t5/image/serverpage/image-id/1350519iCB55845EBFC43016/image-size/large?v=v2&px=999" "Autodesk Design & Make Report")
