Imports a coordinate text file as AutoCAD points
29 Wednesday Jan 2020
Posted Import
in29 Wednesday Jan 2020
Posted Import
in
25 Thursday Oct 2018
Posted Import
in
05 Thursday Feb 2015
(defun ImportTextFile (FileName StPt ArgList / ActDoc CurSpace otmd FileName StPt DilmChar DilmOpt StrRplc MakeCapital DrawGrid TblType TxtHt ClmnWd
TxtSpc Opened tmpTxtLine StrList XOffset tmpSty tmpHt tmpTxt tmpTxt2 YDist XVal YVal cnt1 tempStr tmpPt tempObj ll ur
tempXDist tempList TextObjList MaxRows tempX XList YOffset YList GotYList MaxCol Tbl RowCnt ColCnt ColStrList
ShowTitle ShowHeader CurTxtSty cTxtSty *error* RemoveEndNullStrings TxtAli)
; Imports a .csv or .txt file into columns specified by the user.
; Sub's 'value 'GetCurrentSpace
; The ArgList contents should be formatted like
; 0 = [ string ] Dilimiter character for the file being read in
; 1 = [ string ] The string that will replace empty strings
; 2 = [ string ] Make capital, either Yes / No
; 3 = [ string ] Table type, either Text / taBle
; 4 = [ list of strings ] If Text type of table, then only string within, either Yes / No for drawing a grid,
; if taBle type, then two strings, either Yes / No for each, the first is has title row, second has header row
; 5 = [ real ] Text height
; 6 = [ real ] Text height to spacing ratio
; 7 = [ real ] Text line spacing ratio
; 8 = [ string ] Text style to use
; 9 = [ integer ] Alignment
; Text alignment
; 0 = Left
; 1 = Center
; 2 = Right
; 4 = Middle
; 6 = Top Left
; 7 = Top Center
; 8 = Top Right
; 9 = Middle Left
; 10 = Middle Center
; 11 = Middle Right
; 12 = Bottom Left
; 13 = Bottom Center
; 14 = Bottom Right
; Table alignment
; 1 = Top Left
; 2 = Top Center
; 3 = Top Right
; 4 = Middle Left
; 5 = Middle Center
; 6 = Middle Right
; 7 = Bottom Left
; 8 = Bottom Center
; 9 = Bottom Right
(defun *error* (msg)
(vl-bt)
(prompt (strcat "\n Error--> " msg))
)
;------------------------------------------------------------------
(defun RemoveEndNullStrings (lst)
(setq lst (reverse lst))
(while (= (car lst) "")
(setq lst (cdr lst))
)
(reverse lst)
)
;--------------------------------------------------------------------------
(defun VALUE (num ent /)
(cdr (assoc num ent))
)
;--------------------------------------------------------------------------
(defun GetCurrentSpace (Doc / BlkCol SpaceList CurSpace ActSpace temp1)
; Returns the "block object" for the active space
; Thanks to Jeff Mishler
(if (= (getvar "cvport") 1)
(vla-get-PaperSpace Doc)
(vla-get-ModelSpace Doc)
)
)
;-----------------------------------------------------------------
(defun StrParse (String Seperator / Pos1 Pos2 NewStrList)
;|
Seperator a string (making a list of stings) at a given
string value
ie: (StrParse "1,1,0" ",")
returns: ("1" "1" "0")
Written when I couldn't find it on the web
By: Tim Willey 11/15/2004
|;
(setq Pos2 1)
(while (setq Pos1 (vl-string-search Seperator String Pos1))
(if (= Pos2 1)
(setq NewStrList (cons (substr String Pos2 Pos1) NewStrList))
(setq NewStrList (cons (substr String Pos2 (- (1+ Pos1) Pos2)) NewStrList))
)
(setq Pos2 (1+ (+ (strlen Seperator) Pos1)))
(setq Pos1 (+ Pos1 (strlen Seperator)))
)
(reverse (setq NewStrList (cons (substr String Pos2) NewStrList)))
)
;-----------------------------------------------------------------
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-StartUndoMark ActDoc)
(setq CurSpace (GetCurrentSpace ActDoc))
(setq osmd (getvar "osmode"))
(setq DilmChar (nth 0 ArgList))
(setq StrRplc (nth 1 ArgList))
(setq MakeCapital (nth 2 ArgList))
(setq TblType (nth 3 ArgList))
(if (equal (length (setq tempList (nth 4 ArgList))) 1)
(setq DrawGrid (car tempList))
(progn
(setq ShowTitle (car tempList))
(setq ShowHeader (cadr tempList))
)
)
(setq TxtHt (nth 5 ArgList))
(setq ClmnWd (nth 6 ArgList))
(setq TxtSpc (nth 7 ArgList))
(setq CurTxtSty (nth 8 ArgList))
(setq TxtAli (nth 9 ArgList))
(setq Opened (open FileName "r"))
(while (setq tmpTxtLine (read-line Opened))
(setq StrList
(cons
(StrParse tmpTxtLine DilmChar)
StrList
)
)
)
(close Opened)
(setq StrList
(vl-remove-if-not
'(lambda (x)
(vl-position nil (mapcar '(lambda (y) (= y "")) x))
)
StrList
)
)
(setq StrList
(mapcar 'RemoveEndNullStrings StrList)
)
(setq XOffset (* TxtHt ClmnWd))
(if (= TblType "Text")
(progn
(setvar "osmode" 0)
(setq cTxtSty (getvar 'TextStyle))
(setvar 'TextStyle CurTxtSty)
(setq tmpSty (vla-get-ActiveTextStyle ActDoc))
(setq tmpHt (vla-get-Height tmpSty))
(vla-put-Height tmpSty 0.0)
(command "_.text" StPt TxtHt 0.0 ".")
(setq tmpTxt (entlast))
(command "_.text" "" ".")
(setq tmpTxt2 (entlast))
(setq YDist (distance (value 10 (entget tmpTxt)) (value 10 (entget tmpTxt2))))
(setq YDist (* TxtSpc YDist))
(entdel tmpTxt)
(entdel tmpTxt2)
(setvar 'TextStyle cTxtSty)
(vla-put-Height tmpSty tmpHt)
(setq XVal (car StPt))
(setq YVal (cadr StPt))
(foreach lst (reverse StrList)
(setq cnt1 0)
(foreach tempStr lst
(setq tmpPt (list XVal YVal))
(if (= tempStr "")
(setq tempStr StrRplc)
)
(if (= MakeCapital "Yes")
(setq tempStr (strcase tempStr))
)
(if (/= tempStr "")
(progn
(setq tempObj (vla-AddText CurSpace (vl-string-trim " " tempStr) (vlax-3d-point tmpPt) TxtHt))
(vla-put-StyleName tempObj CurTxtSty)
(vla-GetBoundingBox tempObj 'll 'ur)
(setq tempXDist
(abs
(-
(car (safearray-value ll))
(car (safearray-value ur))
)
)
)
(if (setq tempList (assoc cnt1 TextObjList))
(setq TextObjList
(subst
(cons
cnt1
(cons
(if (> tempXDist (cadr tempList))
tempXDist
(cadr tempList)
)
(append (cddr tempList) (list tempObj))
)
)
tempList
TextObjList
)
)
(setq TextObjList
(cons
(cons
cnt1
(list
tempXDist
tempObj
)
)
TextObjList
)
)
)
)
)
(setq cnt1 (1+ cnt1))
(setq XVal (+ XVal 5))
)
(setq YVal (- YVal YDist))
)
(setq TextObjList (vl-sort TextObjList '(lambda (a b) (
)
)
)
(setq tempX (car StPt))
(setq XList (list (- tempX (* XOffset 0.5))))
(setq YOffset (+ TxtHt (* (- YDist TxtHt) 0.5)))
(foreach lst TextObjList
(foreach obj (cddr lst)
(setq tmpPt
(vlax-get
obj
(if (equal (vla-get-Alignment obj) 0)
'InsertionPoint
'TextAlignmentPoint
)
)
)
(if
(and
(not GotYList)
(equal (length lst) MaxRows)
)
(setq YList (cons (+ (cadr tmpPt) YOffset) YList))
)
(setq tmpPt
(cons
(cond
((vl-position TxtAli '(0 6 9 12))
tempX
)
((vl-position TxtAli '(1 4 7 10 13))
(+ tempX (/ (cadr lst) 2.))
)
(t
(+ tempX (cadr lst))
)
)
(list
(cond
((vl-position TxtAli '(6 7 8))
(+ TxtHt (cadr tmpPt))
)
((vl-position TxtAli '(4 9 10 11))
(+ (* TxtHt 0.5) (cadr tmpPt))
)
((vl-position TxtAli '(12 13 14))
(- (/ TxtHt 3.) (cadr tmpPt))
)
(t
(cadr tmpPt)
)
)
(caddr tmpPt)
)
)
)
(vla-put-Alignment obj TxtAli)
(vla-Update obj)
(vlax-put
obj
(if (equal TxtAli 0)
'InsertionPoint
'TextAlignmentPoint
)
tmpPt
)
)
(setq tempX (+ (+ XOffset (cadr lst)) tempX))
(setq XList (cons (- tempX (* XOffset 0.5)) XList))
(if YList
(setq GotYList T)
)
)
(setq YList (cons (- (car YList) (+ YOffset (* (- YDist TxtHt) 0.5))) YList))
(if (= DrawGrid "Yes")
(progn
(foreach xVal XList
(vlax-invoke CurSpace 'AddLine (list xVal (car YList) 0.0 ) (list xVal (last YList) 0.0))
)
(foreach yVal YList
(vlax-invoke CurSpace 'AddLine (list (car XList) yVal 0.0) (list (last XList) yVal 0.0))
)
)
)
)
(progn
(setq MaxCol
(car
(vl-sort
(mapcar 'length StrList)
'>
)
)
)
(setq Tbl (vlax-invoke CurSpace 'AddTable StPt (length StrList) MaxCol TxtHt 1.0))
(if (= ShowTitle "Yes")
(vla-put-TitleSuppressed Tbl :vlax-false)
(vla-put-TitleSuppressed Tbl :vlax-true)
)
(if (= ShowTitle "Yes")
(vla-put-HeaderSuppressed Tbl :vlax-false)
(vla-put-HeaderSuppressed Tbl :vlax-true)
)
(vla-SetAlignment Tbl acTitleRow 5)
(vla-SetAlignment Tbl acHeaderRow 5)
(vla-SetAlignment Tbl acDataRow TxtAli)
(vla-put-RegenerateTableSuppressed Tbl :vlax-true)
(setq RowCnt 0)
(foreach lst (reverse StrList)
(setq ColCnt 0)
(foreach str lst
(if (= MakeCapital "Yes")
(setq str (strcase str))
)
(if (= (vl-string-trim " " str) "")
(vla-SetText Tbl RowCnt ColCnt StrRplc)
(vla-SetText Tbl RowCnt ColCnt (vl-string-trim " " str))
)
(vla-SetCellTextStyle Tbl RowCnt ColCnt CurTxtSty)
(vla-SetCellTextHeight Tbl RowCnt ColCnt TxtHt)
(if (setq tempList (assoc ColCnt ColStrList))
(if (> (strlen str) (strlen (cdr tempList)))
(setq ColStrList (subst (cons ColCnt str) tempList ColStrList))
)
(setq ColStrList (cons (cons ColCnt str) ColStrList))
)
(setq ColCnt (1+ ColCnt))
)
(setq RowCnt (1+ RowCnt))
)
(foreach lst (mapcar
'(lambda (x / ll ur tempObj)
(setq tempObj (vlax-invoke CurSpace 'AddText (cdr x) '(0. 0. 0.) TxtHt))
(vla-put-StyleName tempObj CurTxtSty)
(vla-GetBoundingBox tempObj 'll 'ur)
(vla-Delete tempObj)
(cons
(car x)
(+
(* XOffset 2.)
(abs
(-
(car (safearray-value ll))
(car (safearray-value ur))
)
)
)
)
)
ColStrList
)
(vla-SetColumnWidth Tbl (car lst) (cdr lst))
)
(setq RowCnt 0)
(repeat (length StrList)
(vla-SetRowHeight Tbl RowCnt (* TxtHt TxtSpc))
(setq RowCnt (1+ RowCnt))
)
(vla-put-RegenerateTableSuppressed Tbl :vlax-false)
)
)
(setvar "osmode" osmd)
(vla-EndUndoMark ActDoc)
)
(defun c:txt (/ DiaId Rslt FileName StPt StyList GrabTextStyles TextAliList TableAliList
TextAli TableAli)
(defun GrabTextStyles (/ tempName StyNameList)
(vlax-for sty (vla-get-TextStyles (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(if (not (wcmatch "|" (setq tempName (vla-get-Name sty))))
(setq StyNameList (cons tempName StyNameList))
)
)
StyNameList
)
;---------------------------------------------------------------------
(defun GrabDialogResults ()
(list
(cond
((= (get_tile "TabRad") "1")
"\t"
)
((= (get_tile "CommaRad") "1")
","
)
((= (get_tile "OtherRad") "1")
(get_tile "OtherEb")
)
)
(get_tile "RplcStrEb")
(if (= (get_tile "CapYesRad") "1")
"Yes"
"No"
)
(if (= (get_tile "TextRad") "1")
"Text"
"taBle"
)
(if (= (get_tile "TextRad") "1")
(list
(if (= (get_tile "GridYesRad") "1")
"Yes"
"No"
)
)
(list
(if (= (get_tile "TitleYesRad") "1")
"Yes"
"No"
)
(if (= (get_tile "HeadYesRad") "1")
"Yes"
"No"
)
)
)
(distof (get_tile "TextHtEb"))
(distof (get_tile "HtRatEb"))
(distof (get_tile "LnSpcRatEb"))
(nth
(atoi
(get_tile "TextStyPul")
)
StyList
)
(cdr
(nth
(atoi
(get_tile "AliPul")
)
(if (= (get_tile "TextRad") "1")
TextAliList
TableAliList
)
)
)
)
)
;--------------------------------------------------------------------
(setq DiaId (load_dialog "text.dcl"))
(if
(and
(setq FileName (getfiled "Select file to read." "" "txt;csv" 4))
(setq StyList (GrabTextStyles))
(setq TextAliList
'(
("Left" . 0)
("Center" . 1)
("Right" . 2)
("Middle" . 4)
("Top Left" . 6)
("Top Center" . 7)
("Top Right" . 8)
("Middle Left" . 9)
("Middle Center" . 10)
("Middle Right" . 11)
("Bottom Left" . 12)
("Bottom Center" . 13)
("Bottom Right" . 14)
)
)
(setq TextAli "Bottom Left")
(setq TableAliList
'(
("Top Left" . 1)
("Top Center" . 2)
("Top Right" . 3)
("Middle Left" . 4)
("Middle Center" . 5)
("Middle Right" . 6)
("Bottom Left" . 7)
("Bottom Center" . 8)
("Bottom Right" . 9)
)
)
(setq TableAli "Bottom Left")
(new_dialog "ImportText" DiaId)
)
(progn
(start_list "TextStyPul" 3)
(foreach name StyList
(add_list name)
)
(end_list)
(start_list "AliPul" 3)
(foreach lst TextAliList
(add_list (car lst))
)
(end_list)
(set_tile "TabRad" "1")
(set_tile "CapNoRad" "1")
(set_tile "TextHtEb" (rtos (getvar 'TextSize)))
(set_tile "HtRatEb" "1.0")
(set_tile "LnSpcRatEb" "1.5")
(set_tile "TextRad" "1")
(set_tile "GridNoRad" "1")
(set_tile "TitleNoRad" "1")
(set_tile "HeadYesRad" "1")
(set_tile "TextStyPul"
(itoa
(vl-position
(getvar 'TextStyle)
StyList
)
)
)
(set_tile "AliPul"
(itoa
(vl-position (assoc TextAli TextAliList) TextAliList)
)
)
(mode_tile "HeadRadCol" 1)
(mode_tile "TitleRadCol" 1)
(mode_tile "OtherEb" 1)
(action_tile "OtherRad"
"(progn
(set_tile \"CommaRad\" \"0\")
(set_tile \"TabRad\" \"0\")
(mode_tile \"OtherEb\" 0)
(mode_tile \"OtherEb\" 2)
)"
)
(action_tile "CommaRad"
"(progn
(set_tile \"OtherRad\" \"0\")
(mode_tile \"OtherEb\" 1)
)"
)
(action_tile "TabRad"
"(progn
(set_tile \"OtherRad\" \"0\")
(mode_tile \"OtherEb\" 1)
)"
)
(action_tile "TextRad"
"(progn
(mode_tile \"HeadRadCol\" 1)
(mode_tile \"TitleRadCol\" 1)
(mode_tile \"GridRadCol\" 0)
(setq TableAli
(car (nth (atoi (get_tile \"AliPul\")) TableAliList))
)
(start_list \"AliPul\" 3)
(foreach lst TextAliList
(add_list (car lst))
)
(end_list)
(set_tile \"AliPul\"
(itoa
(vl-position (assoc TextAli TextAliList) TextAliList)
)
)
)"
)
(action_tile "TblRad"
"(progn
(mode_tile \"HeadRadCol\" 0)
(mode_tile \"TitleRadCol\" 0)
(mode_tile \"GridRadCol\" 1)
(setq TextAli
(car (nth (atoi (get_tile \"AliPul\")) TextAliList))
)
(start_list \"AliPul\" 3)
(foreach lst TableAliList
(add_list (car lst))
)
(end_list)
(set_tile \"AliPul\"
(itoa
(vl-position (assoc TableAli TableAliList) TableAliList)
)
)
)"
)
(action_tile "ProBtn"
"(progn
(setq Rslt (GrabDialogResults))
(done_dialog 1)
)"
)
(if
(and
(equal (start_dialog) 1)
(setq StPt (getpoint "\n Select point for first line of text: "))
)
(ImportTextFile
FileName
StPt
Rslt
)
)
)
)
(princ)
)
(defun c:-ImportTextFile (/ FileName StPt DilmChar DilmOpt StrRplc MakeCapital TblType DrawGrid
ShowTitle ShowHeader TxtHt ClmnWid TxtSpc)
(if
(and
(setq FileName (getfiled "Select file to read." "" "csv;txt" 4))
(setq StPt (getpoint "\n Select point for first line of text: "))
(not (initget "Tab Comma Other"))
(setq DilmChar
(cond
((setq DilmOpt (getkword "\n How is the file dilimiated [Comman/Tab/Other] : "))
(if (= DilmOpt "Other")
(if (= (setq DilmOpt (getstring "\n Enter character to dilimaiate at: ")) "")
nil
DilmOpt
)
DilmOpt
)
)
((= DilmChar "Tab")
"\t"
)
(t ",")
)
)
(setq StrRplc
(cond
((getstring T "\n Enter text to replace empty strings with [enter for none]: "))
(t "")
)
)
(not (initget "Yes No"))
(setq MakeCapital
(cond
((getkword "\n Make entire sting capital [Yes/No] : "))
(t "Yes")
)
)
(not (initget "Text taBle"))
(setq TblType
(cond
((getkword "\n Type of table [Text/taBle] : "))
(t "Text")
)
)
(cond
((= TblType "Text")
(initget "Yes No")
(setq DrawGrid
(cond
((getkword "\n Draw grid around text [Yes/No] : "))
(t "Yes")
)
)
)
((= TblType "taBle")
(initget "Yes No")
(setq ShowTitle
(cond
((getkword "\n Does table have a title row [Yes/No] : "))
(t "No")
)
)
(initget "Yes No")
(setq ShowHeader
(cond
((getkword "\n Does table have a header row [Yes/No] : "))
(t "Yes")
)
)
)
)
(setq TxtHt
(cond
((getreal (strcat "\n Enter text height [" (rtos (getvar 'TextSize)) "] : ")))
(t (getvar 'TextSize))
)
)
(setq ClmnWd
(cond
((getdist "\n Height to space between (end and start of) text ratio : "))
(t 1.0)
)
)
(setq TxtSpc
(cond
((getdist "\n Enter text line spacing ratio : "))
(t 1.5)
)
)
)
(ImportTextFile
FileName
StPt
(list
DilmChar
StrRplc
MakeCapital
TblType
(if (= TblType "Text")
(list DrawGrid)
(list ShowTitle ShowHead)
)
TxtHt
ClmnWd
TxtSpc
(getvar 'TextStyle)
0
)
)
)
(princ)
)
(c:txt)
********* text.dcl **********
25 Tuesday Nov 2014
Posted Import, Lisp Collection 2014
in
25 Tuesday Nov 2014
Posted Import, Lisp Collection 2014
in
25 Tuesday Nov 2014
Posted Import, Lisp Collection 2014
in
25 Tuesday Nov 2014
Posted Import, Lisp Collection 2014
in;Insert DWG from a folder as blocks
;updates by CAD Studio
(defun c:InsertBlks (/ d doc lst pt pt1 dir b blk blkn ex xx)
(vl-load-com)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(if
(and (setq
dir (vl-filename-directory
(getfiled "Select a DWG for folder" (getvar 'dwgprefix) "dwg" 8)
)
)
(setq lst (vl-directory-files dir "*.dwg"))
(setq xx (princ (strcat "\n" (itoa (length lst)) " blocks found")))
(setq pt1 (getpoint "\nSelect ins.point for first block: "))
(setq d
(distance (getpoint pt1 "\nSelect distance to space blocks (or 0,0): ")
pt1
)
)
(setq ex (= "Y" (strcase (getstring "\nExplode inserted blocks? [Y/N] : "))) xx T)
)
(foreach b lst
(princ (strcat "\n" b " "))
(setq blk (vla-insertblock
(if (= (getvar 'cvport) 1)
(vla-get-paperspace doc)
(vla-get-modelspace doc)
)
(vlax-3d-point (setq pt1 (polar pt1 0.0 d)))
(strcat dir "\\" b)
1
1
1
0.0
));insert, setq
(if ex (progn
(princ " exploding")
(setq blkn (vla-get-effectivename blk))
(vl-catch-all-apply 'vla-explode (list blk)) (vl-catch-all-apply 'vla-delete (list blk))
(vl-catch-all-apply 'vla-delete (list (vla-item (vla-get-blocks doc) blkn)))
))
); for
)
(princ "Done.")
(princ)
)
(c:InsertBlks)