Community
@orourkestuart wrote:
..What I need is a LISP to read in a csv and create a "DIAG_CROSS" block at each of the coordinates and generate 8 block attributes that match the points attribute tables, the last column in the csv contains the target layer designation for the block.
..
Questions:
- Do you want to maintain the DIAG_CROSS block definition at it is now? Its a non-attributed block.
- What about colors? it doesnt show anywhere on the csv file, drawing sample shows colors as ByBlock.
- AttDisp is OFF. so attributes are not invisble. is that by design?
- DIAG_CROSS is inserted at scale 0.0010 for X, Y and Z.
@orourkestuart wrote:
So if I'm going to do that I should probably write a "DIAG_CROSS" with the attributes already in it?
Preferably yes, BUT we can still work on its current state if redefining the block will cause to much trouble.
What ever makes the transfer of data from Trimble to cad easier for you. Its your call.
@orourkestuart wrote:
I'm not interested in the colour of the block after it's inserted, they act as the 'anchor' when I use my Mleader LISPS ..
One less thing to worry about then. Tell me once you decide what to do with the "DIAG_CROSS" block.
@orourkestuart wrote:
yeah, so I'll reauthor the block and give it attributes:
Settled then, post the block when your'e done "reauthoring" . Its an easy code and simple program
Here is my starting code. Test it when you create block with attributes you described.
I didn't have time to create required block, so there may be some error that I can fix later.
(defun c:diag-cross-csv
;hak_vz 11.20.2020
( /
*error* LM:str->lst LM:vl-setattributevalue f file1 defs
restdefs x y z layer record
)
(defun *error* ()
(setvar 'cmdecho 1)
(close file1)
)
(defun LM:str->lst ( str del / pos )
(if (setq pos (vl-string-search del str))
(cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
(list str)
)
)
(defun LM:vl-setattributevalue ( blk tag val)
(setq tag (strcase tag))
(vl-some
'(lambda ( att )
(if (= tag (strcase (vla-get-tagstring att)))
(progn (vla-put-textstring att val) val)
)
)
(vlax-invoke blk 'getattributes)
)
)
(setvar 'cmdecho 0)
(setq f (getfiled "Open csv file" (getvar "dwgprefix") "txt" 2) file1 (open f "r"))
(setq defs (LM:str->lst (read-line file1) ","))
(setq restdefs '("Pt" "CODE" "DEPTH" "SIZE" "MATERIAL" "COMMONNOTES" "END""NUMBEROF" "METHOD" "NOTES"))
(while (setq record (read-line file1))
(setq record (mapcar 'cons defs (LM:str->lst record ",")))
(setq x (atof(cdr (assoc "X" record))))
(setq y (atof(cdr (assoc "Y" record))))
(setq z (atof(cdr (assoc "Z" record))))
(setq layer (cdr (assoc "LAYER" record)))
(command "._layer" "_M" layer "")
(setvar 'clayer layer)
(command "-insert" "diag_cross" (list x y z) 1 1 0 "")
(foreach value restdefs
(LM:vl-setattributevalue (entlast) value (cdr (assoc value record)))
)
)
(setvar 'cmdecho 1)
(close file1)
(princ "\nDone")
)
(princ "\nType DIAG-CROSS-CSV to run command")
(princ)
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
In attachment are three files i.e. updated code, test file, and dwg with diag_cross attribute defined.
Default x and y scale for block are set to 0.1.
In text file first line is all caps.
PT,X,Y,Z,CODE,DEPTH,SIZE,MATERIAL,COMMONNOTES,END,NUMBEROF,METHOD,NOTES,LAYER
(defun c:diag-cross-csv
;hak_vz 11.21.2020
( /
*error* LM:str->lst LM:vl-setattributevalue f file1 defs pt
restdefs x y z layer record xscale yscale rotation attlist e0
)
(defun *error* ()
(setvar 'cmdecho 1)
(close file1)
)
(defun LM:str->lst ( str del / pos )
(if (setq pos (vl-string-search del str))
(cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
(list str)
)
)
(setq xscale (getreal "Block X scale <0.1> >"))
(setq yscale (getreal "Block Y scale <0.1> >"))
(setq rotation (getreal "Block rotation angle <0> >"))
(initget "YES NO")
(if (null (setq use_z(getkword "\nUse Z [Yes/No] <No> >")))
(setq use_z "NO")
)
(if (not xscale) (setq xscale 0.1))
(if (not yscale) (setq yscale 0.1))
(if (not rotation) (setq rotation 0))
(setvar 'cmdecho 0)
(setvar 'ATTDIA 0)
(setq f (getfiled "Open csv file" (getvar "dwgprefix") "txt" 2) file1 (open f "r"))
(setq defs (LM:str->lst (read-line file1) ","))
(setq restdefs '("PT" "CODE" "DEPTH" "SIZE" "MATERIAL" "COMMONNOTES" "END""NUMBEROF" "METHOD" "NOTES"))
(while (setq record (read-line file1))
(setq record (mapcar 'cons defs (LM:str->lst record ",")))
(setq x (atof(cdr (assoc "X" record))))
(setq y (atof(cdr (assoc "Y" record))))
(setq z (atof(cdr (assoc "Z" record))))
(if (= use_z "NO") (setq pt (list x y)) (setq pt (list x y z)))
(setq layer (cdr (assoc "LAYER" record)))
(command "_.layer" "_M" layer "")
(setvar 'clayer layer)
(command "-insert" "diag_cross" pt xscale yscale rotation)
(while (> (getvar 'cmdactive) 0) (command ""))
(foreach value restdefs (setq attlist (cons (cons value (cdr (assoc value record))) attlist)))
(foreach att (vlax-invoke (vlax-ename->vla-object (entlast)) 'getattributes)(if (setq itm (assoc (vla-get-tagstring att) attlist))(vla-put-textstring att (cdr itm))))
(setq attlist nil)
)
(setvar 'cmdecho 1)
(close file1)
(setvar 'ATTDIA 1)
(princ "\nDone")
)
(princ "\nType DIAG-CROSS-CSV to run command")
(princ)
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Check the code to see it works well with larger dataset. If there is something to add just ask.
This was not such a big problem to code and it can also be used in my practice.
If this is what you asked for accept my reply with autolisp code under #8 as a solution to this post.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
@orourkestuart wrote:Apologies for you guys having to author the block on my behalf,
I would have rather you create the block, so you get what you ask for kinda thing. My idea was maintain the color of the object to "bylock" so the program can still assign a color to differentiate the items visually even without a defined layer on the drawing, similar to your sample drawing.
Anyway, i wanted to write something else entirely different, leave the blocks as it is [ non-attributed block ], and add attributes on the fly, it can be any of the blocks on your drawing and it can also add any attribute tags names from the csv.
(setq validBlocks
'("BOX" "CIRCLE" "CROSS"
"DIAG_CROSS" "DOUBLE_CIRCLE" "DOUBLE_TRIANGLE"
"STAKED_FLAG" "TRIANGLE"
)
)
I had many plans to streamline your work.
For now we will apply the KISS principle.
(defun c:DiagCross ( / _DelTolst spc bname allData csv listOfTags Layer
TagAndValue InsertedBlock layername)
(defun _DelTolst ( str m / pos x lst lst2)
(if (setq pos (vl-string-position m str))
(cons (substr str 1 pos) (_DelTolst (substr str (+ pos 2)) m ))
(list str)
)
)
(setq spc (vlax-get (vla-get-ActiveLayout (vla-get-activedocument
(vlax-get-acad-object))) 'Block)
bname "DIAG_CROSS")
(defun Layer (Nme)
(entmake (list (cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2 Nme)
(cons 70 0))))
(if (and
(tblsearch "BLOCK" bname)
(setq allData nil
csv (getfiled "Select data source" (getvar 'dwgprefix) "csv" 16))
)
(progn
(setq opf (open csv "r"))
(setq NameAndTag (_DelTolst (read-line opf) 44))
(setq listOfTags (cons (Car NameAndTag) (cddddr NameAndTag)))
(while (setq data (read-line opf))
(setq allData (cons (_DelTolst data 44) allData))
)
(close opf)
(setq sc (if (zerop (getvar 'Luprec)) 1.0 0.001))
(foreach itm allData
(setq pt
(mapcar 'atof (list (cadr itm) (caddr itm) (cadddr itm)))
)
(setq itm (cons (Car itm) (cddddr itm)))
(setq TagAndValue (mapcar 'cons listOfTags itm))
(setq InsertedBlock
(vlax-invoke
spc 'InsertBlock pt bname sc sc sc 0)
)
(foreach att (Vlax-invoke InsertedBlock 'GetAttributes)
(if (setq f (Assoc (strcase (vla-get-tagstring att)) TagAndValue)
)
(Vla-put-textstring att (Cdr f))
)
)
(if (not (tblsearch "Layer" (setq lname (last itm))))
(Layer lname))
(Vla-put-layer InsertedBlock lname)
)
)
)
(princ)
)The LUPREC system variable will dictate the size of the block. MM (0) M (any number except 0)).
The program is prompting for CSV extension instead of txt.
HTH
@orourkestuart wrote:
@pbejse, morning 🙂 Your script runs except I'm not getting the PT attribute populated. I've attached a .dwg that HAK_VZ was kind enough tom supply containing a diag_cross block in it that I will adopt as our own.
Here you go.
(defun c:DiagCross ( / _DelTolst spc bname allData csv listOfTags Layer
TagAndValue InsertedBlock layername)
(defun _DelTolst ( str m / pos x lst lst2)
(if (setq pos (vl-string-position m str))
(cons (substr str 1 pos) (_DelTolst (substr str (+ pos 2)) m ))
(list str)
)
)
(setq spc (vlax-get (vla-get-ActiveLayout (vla-get-activedocument
(vlax-get-acad-object))) 'Block)
bname "DIAG_CROSS")
(defun Layer (Nme)
(entmake (list (cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2 Nme)
(cons 70 0))))
(if (and
(tblsearch "BLOCK" bname)
(setq allData nil
csv (getfiled "Select data source" (getvar 'dwgprefix) "csv;txt" 16))
)
(progn
(setq opf (open csv "r"))
(setq NameAndTag (_DelTolst (read-line opf) 44))
(setq listOfTags (mapcar 'strcase (cons (Car NameAndTag) (cddddr NameAndTag))))
(while (setq data (read-line opf))
(setq allData (cons (_DelTolst data 44) allData))
)
(close opf)
(setq sc (if (zerop (getvar 'Luprec)) 1.0 0.001))
(foreach itm allData
(setq pt
(mapcar 'atof (list (cadr itm) (caddr itm) (cadddr itm)))
)
(setq itm (cons (Car itm) (cddddr itm)))
(setq TagAndValue (mapcar 'cons listOfTags itm))
(setq InsertedBlock
(vlax-invoke
spc 'InsertBlock pt bname sc sc sc 0)
)
(foreach att (Vlax-invoke InsertedBlock 'GetAttributes)
(if (setq f (Assoc (strcase (vla-get-tagstring att)) TagAndValue)
)
(Vla-put-textstring att (Cdr f))
)
)
(if (not (tblsearch "Layer" (setq lname (last itm))))
(Layer lname))
(Vla-put-layer InsertedBlock lname)
)
)
)
(princ)
)
Now you can select either csv or txt
HTH
Think about if you want to pursue the other option of using the none attribute blocks? Its a good alternative.
@hak_vz wrote:
@pbejseYou've done nice work.
Thank you for saying that @hak_vz , you are not so bad yourself buddy. Keep up the good work.
And if you liked that code, you would've flipped with what i had originally planned for the OP as mentioned on post # 12.
Too bad the OP did not sign off on it. 😊
@pbejse wrote:.....you would've flipped with what i had originally planned for the OP as mentioned on post # 12.
Actually I was thinking about that option too. This is the way to go since blocks are than tailored for particular job.
As you say in other topic, generic solutions are better option.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Forums Links
Can't find what you're looking for? Ask the community or share your knowledge.
Post to forums
