;; Select texts inside closed areas and make table with areas of corresponding texts

(defun c:art (/ cm ob ss no in sn en ls fl op)
;; Tharwat 22.Feb.2016 ;;
;; Modyfied by Igal Averbuh 2016 ;;
(command "-layer" "m" "0-TEMP" "")
(princ "\nSelect (m)Texts inside closed areas:")
(if (setq ob (entlast) ss (ssget '((0 . "*TEXT"))))
(progn
(setq cm (getvar 'CMDECHO)
in (sslength ss)
no in)
(setvar 'CMDECHO 0)
(repeat in
(command "_.-boundary" "_none" (cdr (assoc 10 (setq en (entget (ssname ss (setq in (1- in))))))) "")
(if (and (not (eq ob (setq sn (entlast))))
(eq "LWPOLYLINE" (cdr (assoc 0 (entget sn))))
)
(progn
(setq ob sn
ls (cons (list (Clear_Mtext_String (cdr (assoc 1 en))) (rtos (vlax-curve-getarea ob) 2 )) ls)
)
(entdel sn)
)
)
)
(setvar 'CMDECHO cm)
)
)

(if (and ls (setq fl (getfiled "\nSpeficy txt file name :" "" "csv" 1))
(setq op (open fl "w"))
)
(progn
(write-line "No Area:" op)
(foreach st ls
(write-line (strcat (car st) " " (cadr st)) op)
)
(close op)
(if (/= no (length ls))
(alert (strcat "Couldn't create a boundary with a number of Plot(s): [" (itoa (- no (length ls))) "]."))
)
)
)
(princ)
)
(defun Clear_Mtext_String (String / Text Str)
;; ASMI - sub-function ;;
;; Get string from Formatted Mtext string ;;
(setq Text "")
(while (/= String "")
(cond ((wcmatch (strcase (setq Str (substr String 1 2))) "\\[\\{}`~]")
(setq String (substr String 3)
Text (strcat Text Str)
)
)
((wcmatch (substr String 1 1) "[{}]") (setq String (substr String 2)))
((and (wcmatch (strcase (substr String 1 2)) "\\P") (/= (substr String 3 1) " "))
(setq String (substr String 3)
Text (strcat Text " ")
)
)
((wcmatch (strcase (substr String 1 2)) "\\[LOP]") (setq String (substr String 3)))
((wcmatch (strcase (substr String 1 2)) "\\[ACFHQTW]")
(setq String (substr String (+ 2 (vl-string-search ";" String))))
)
((wcmatch (strcase (substr String 1 2)) "\\S")
(setq Str (substr String 3 (- (vl-string-search ";" String) 2))
Text (strcat Text (vl-string-translate "#^\\" " " Str))
String (substr String (+ 4 (strlen Str)))
)
(print Str)
)
(T
(setq Text (strcat Text (substr String 1 1))
String (substr String 2)
)
)
)
)
Text
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; TABLE.LSP
;;; This routine can read a comma seperated variable (CSV) file and import
;;; them to AutoCAD drafting screen as a table.
;;; Copyright 1997 Yuqun Lian, SimpleCAD http://www.simplecad.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Set the global variables, you can freely edit them
(setq ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
x_distance 10
y_distance 2
text_height 1
text_style "complex.shx"
text_align "ml"
) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:csvtable(/ txt txt_lst x y)
(command "-layer" "m" "0-TABLE" "")
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "style" "txt_style" text_style text_height "1.0" "" "" "" "")
(setq data_file (getfiled "Select a data file" "" "CSV" 0))
(setq start_pt (getpoint "\nPick the left-upper corner for the table: "))
(setq y (cadr start_pt))
(setq fp (open data_file "r"))
;; read data
(while (setq txt (read-line fp))
(setq txt_lst (parse txt))
(setq x (car start_pt))
(print_lst txt_lst)
(setq y (- y y_distance))
)
(close fp)
)

(defun parse(txt / n count word lst in_quart)
(setq n (strlen txt) count 1 word "" in_quart nil lst nil)
(while (<= count n)
(setq char (substr txt count 1))

(if (= char "\"")
(if in_quart
(setq in_quart nil)
(setq in_quart T)
)
)

(if (and (= char ",")(= in_quart nil))
(progn
(setq lst (append lst (list word)))
(setq word "")
)
(progn
(if (/= char "\"")
(setq word (strcat word char))
)
(if (= count n)
(setq lst (append lst (list word)))
)
)
)
(setq count (1+ count))
)
(setq lst lst)
)

(defun print_lst (lst / txt txt_pt)
(foreach txt lst
(setq txt_pt (list x y))
(command ".text" "s" "txt_style" "j" text_align txt_pt "0" txt )
(setq x (+ x x_distance))
)
)

(princ)

(defun c:car()
(c:art)
(c:csvtable)
)

(c:car)

Advertisements