Jump to content

Creating macro for transporting coordinates to excel/textfile


Recommended Posts

Posted

For sure you can automate the creation of the block; I will detail you the simplest solution. First check if the block isn’t already defined with TBLSEARCH and after call AutoCAD required commands using the function COMMAND.

To be sure about inputs, just call command line versions of commands (-ATTDEF and -BLOCK) and write down the prompts.

Please try to write by yourself this function using the above code examples. If you get stuck, then post your attempt here for debug help.

 

Regarding the second question, the function to extract attributes is different than the one for text; I suggest you to search for an existing one and change it to your needs or use EATTEXT command.

  • Replies 56
  • Created
  • Last Reply

Top Posters In This Topic

  • Technick

    27

  • MSasu

    26

  • BIGAL

    2

  • Lee Mac

    2

Top Posters In This Topic

Posted

It is asking for "Select objects", I guess this need to be for example a prenamed point?

 

(defun c:LSM( / OldLayer OldAttReq layerName pt ans )        ;localize variables to avoid conflicts
  (setq layerName "LS machinery")                   ;use a variable since need in many places
  (setq OldLayer  (getvar "CLAYER")
        OldAttReq (getvar "ATTREQ"))
  (if (not (tblsearch "BLOCK" "ENG"))
    (Command "-block" "ENG" "0,0")  
   (exit)
   )
........

Posted

The example below will create a block from a circle:

(command "_CIRCLE" '(0.0 0.0) 5.0) (setq ent1st (entlast))
(command "_-BLOCK" "CC1" '(0.0 0.0) ent1st "")

Posted

Little unsure about the attributes and how to connect them to the block. Am I on right track? :-)

 

   (setq OldLayer  (getvar "CLAYER")
        OldAttReq (getvar "ATTREQ"))
  (if (not (tblsearch "BLOCK" "ENG"))
   (Command "_ATTDEF" "" "LABEL" "" "" '(0.0 0.0) "" "" (setq test1)
   (Command "_ATTDEF" "" "WEIGHT" "" "" '(0.0 0.0) "" ""(setq test2)
   (command "_CIRCLE" '(0.0 0.0) 5.0) (setq ent1st (entlast))
   (command "_-BLOCK" "ENG" '(0.0 0.0) "ent1st test1 test2" "") 
   (exit)
   )
  )

Posted

I have made some corrections (both syntax and logic) for you:

(if (not (tblsearch "BLOCK" "ENG"))
[color=red] (progn
[/color]  (Command "_ATTDEF" "" "LABEL" "" "" '(0.0 0.0) "" ""[color=red])[/color] (setq test1 [color=red](entlast)[/color])
 (Command "_ATTDEF" "" "WEIGHT" "" "" '(0.0 [color=red]-[/color][color=red]1.0[/color]) "" ""[color=red])[/color] (setq test2 [color=red](entlast)[/color])
 (command "_-BLOCK" "ENG" '(0.0 0.0) [color=red]test1 test2[/color] "")
)
)

Posted

Nice! The LSM works fine now!

 

 (defun c:LSM( / OldLayer OldAttReq layerName pt ans )        ;localize variables to avoid conflicts
  (setq layerName "LS machinery")                   ;use a variable since need in many places
  (setq OldLayer  (getvar "CLAYER")
        OldAttReq (getvar "ATTREQ"))
(if (not (tblsearch "BLOCK" "ENG"))
(progn
 (Command "_ATTDEF" "" "LABEL" "" "" '(0.0 0.0) "" "") (setq test1 (entlast))
 (Command "_ATTDEF" "" "WEIGHT" "" "" '(0.0 -1.0) "" "") (setq test2 (entlast))
 (command "_-BLOCK" "ENG" '(0.0 0.0) test1 test2 "")
)
)
  (if (and (setq pt (getpoint "\nPick point: "))   ;ensure valid user input
           (setq ans (getstring T "\nEnter label: "))
           (setq wgt (getreal  "\nEnter weight: ")))
   (progn                                          ;PROGN required to group statements
    (if (not (tblsearch "LAYER" layerName))        ;create new layer only if required
     (entmake (list '(0 . "LAYER")
                    '(100 . "AcDbSymbolTableRecord")
                    '(100 . "AcDbLayerTableRecord")
                    '(70 . 0)
                    (cons 2 layerName)
                    '(62 . 5)
                    '(6 . "Continuous")
                    '(290 . 0)
                    '(370 . -3)))
    )
    (setvar "CLAYER" layerName)
    (setvar "ATTREQ" 1)
    ;add the block and fill his two attributes
    (command "_INSERT" "ENG" pt 1.0 1.0 0.0 ans (rtos wgt 2 3))
    (setvar "CLAYER" OldLayer)
    (setvar "ATTREQ" OldAttReq)
   )
  )
  (princ)                                          ;exit the routine quietly
 )

Since I don't get the lisp for extracting attributes to excel to work, I tried using the Data Extraction Tool. Problem is that I get the following error when selecting the LSM blocks: "Blocks that were not uniformly scaled were found. Objects in those blocks were not extracted." Also when I tick off "Display blocks with attributes only", LSM is not there. Weight, Label, X and Y is listed when I select the block without attributes, but there are no values in them. Got any solution to this?

Posted

Update:

I tried using this code for extraction and it worked!:)

 ; Global ATTribute EXtractor 
 ; by Miklos Fuccaro mfuccaro@hotmail.com 
 ;-------------------------November 2004 ------- 
;;Edited March 2006 by C. Bassler to allow specification of block and tage names to extract

(defun gattex  ()
 
 (setq Blocklist '("ENG"))
 ;; ** edit to include block names to select
 (setq TagList '("WEIGHT" "LABEL" ))
 ;; ** edit to include tag names to extract
 ;;create block names separated by columns, for selection filter
 (setq Blocknames (List2String BlockList))
 (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 BlockNames))))
 (if (not ss)
   (quit))
 (setq Root (getvar "DWGPREFIX"))
 (setq file (open (strcat Root "attributes.CSV") "w")
       i    -1)
 (write-line
   (strcat Root
           (getvar "DWGNAME")
           " -found "
           (itoa (sslength ss))
           " block(s) with attributes")
   file)
 (repeat (sslength ss)
   (setq TagRow nil
         ValRow nil)
   (setq Edata (entget (setq e (ssname ss (setq i (1+ i))))))
   (write-line "" file)
   (write-line (strcat "block name:" "," (Dxf 2 Edata)) file)
   (while (/= (Dxf 0 Edata) "SEQEND")
     (if
       (and
         (= (Dxf 0 Edata) "ATTRIB")
         (member (dxf 2 Edata) TagList)
         ;;if tag is on list
         ) ;and
        (progn
          (setq TagRow (cons (Dxf 2 Edata) TagRow))
          (setq valRow (cons (Dxf 1 Edata) ValRow))
          ) ;progn
        )
     (setq Edata (entget (setq e (entnext e))))
     ) ;while
   (write-line (List2String (reverse TagRow)) file)
   (write-line (List2String (reverse ValRow)) file)
   ) ;repeat 
 (close file)
 (princ (strcat "\nDone writing file " Root "attributes.csv"))
 (princ)
 ) ;defun
;;-------------------------------
(defun List2String  (Alist)
 (setq NumStr (length Alist))
 (foreach Item  AList
   (if (= Item (car AList))
     ;;first item
     (setq LongString (car AList))
     (setq LongString (strcat LongString "," Item))
     )
   )
 LongString
 ) ;defun
;;--------------------------------
(defun Dxf  (code pairs)
 (cdr (assoc code pairs))
 )
(gattex)

 

Is there some way of making this one include x and y coordinate too? Also writing it like excel in format used before: LABEL|WEIGHT|X|Y

Posted

I managed to get the excel file in format LABEL|WEIGHT:

; Global ATTribute EXtractor 
 ; by Miklos Fuccaro mfuccaro@hotmail.com 
 ;-------------------------November 2004 ------- 
;;Edited March 2006 by C. Bassler to allow specification of block and tage names to extract

(defun gattex  ()
 
 (setq Blocklist '("ENG"))
 ;; ** edit to include block names to select
 (setq TagList '("WEIGHT" "LABEL" ))
 ;; ** edit to include tag names to extract
 ;;create block names separated by columns, for selection filter
 (setq Blocknames (List2String BlockList))
 (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 BlockNames))))
 (if (not ss)
   (quit))
 (setq Root (getvar "DWGPREFIX"))
 (setq file (open (strcat Root "attributes.CSV") "w")
       i    -1)
 (repeat (sslength ss)
   (setq TagRow nil
         ValRow nil)
   (setq Edata (entget (setq e (ssname ss (setq i (1+ i))))))
   (while (/= (Dxf 0 Edata) "SEQEND")
     (if
       (and
         (= (Dxf 0 Edata) "ATTRIB")
         (member (dxf 2 Edata) TagList)
         ;;if tag is on list
         ) ;and
        (progn
          (setq TagRow (cons (Dxf 2 Edata) TagRow))
          (setq valRow (cons (Dxf 1 Edata) ValRow))
          ) ;progn
        )
     (setq Edata (entget (setq e (entnext e))))
     ) ;while
   (write-line (List2String (reverse ValRow)) file)
   ) ;repeat 
 (close file)
 (princ (strcat "\nDone writing file " Root "attributes.csv"))
 (princ)
 ) ;defun
;;-------------------------------
(defun List2String  (Alist)
 (setq NumStr (length Alist))
 (foreach Item  AList
   (if (= Item (car AList))
     ;;first item
     (setq LongString (car AList))
     (setq LongString (strcat LongString ";" Item))
     )
   )
 LongString
 ) ;defun
;;--------------------------------
(defun Dxf  (code pairs)
 (cdr (assoc code pairs))
 )
(gattex)

 

Problem is the x and y coordinates. Perhaps a solution creating x and y attributes (to avoid problem with UCS and WCS)?

Posted

This may help you:

...
(setq Edata (entget (setq e (ssname ss (setq i (1+ i))))))
[color=magenta](setq pointIns (trans (cdr (assoc 10 Edata)) 0 1))[/color]
(while (/= (Dxf 0 Edata) "SEQEND")
...

 

I really don’t like the solution to store insertion point’s coordinates as attributes. What will happen if someone decides to adjust the location of a block marker?

Posted

For an esthetical adjustment to your LSM function, I suggest to check the CMDECHO system variable (use it similar with CLAYER and ATTREQ).

Also, to avoid interference with current Osnap preferences, may disable temporarily the OSMODE system variable.

 

Since you have added new variables inside that function, is a good programming practice to localize those too - to avoid conflicts with other routines.

Posted

Is there some way to see which string has an error? I get following error: ; error: too few arguments

 

 ; Global ATTribute EXtractor 
 ; by Miklos Fuccaro mfuccaro@hotmail.com 
 ;-------------------------November 2004 ------- 
;;Edited March 2006 by C. Bassler to allow specification of block and tage names to extract

(defun gattex  ()
 
 (setq Blocklist '("ENG"))
 ;; ** edit to include block names to select
 (setq TagList '("WEIGHT" "LABEL" ))
 ;; ** edit to include tag names to extract
 ;;create block names separated by columns, for selection filter
 (setq Blocknames (List2String BlockList))
 (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 BlockNames))))
 (if (not ss)
   (quit))
 (setq Root (getvar "DWGPREFIX"))
 (setq file (open (strcat Root "attributes.CSV") "w")
       i    -1)
 (repeat (sslength ss)
   (setq TagRow nil
         ValRow nil)
   (setq Edata (entget (setq e (ssname ss (setq i (1+ i))))))
   (while (/= (Dxf 0 Edata) "SEQEND")
     (if
       (and
         (= (Dxf 0 Edata) "ATTRIB")
         (member (dxf 2 Edata) TagList)
         ;;if tag is on list
         ) ;and
        (progn
          (setq TagRow (cons (Dxf 2 Edata) TagRow))
          (setq valRow (cons (Dxf 1 Edata) ValRow))
          ) ;progn
        )
     (setq Edata (entget (setq e (entnext e))))
     ) ;while
   (setq pointX (trans (cdr (assoc 10 Edata))))
   (setq pointY (trans (cdr (assoc 20 Edata))))    
   (setq valRow (cons (pointX) ValRow))
   (setq valRow (cons (pointY) ValRow))
   (write-line (List2String (reverse ValRow)) file)
   ) ;repeat 
 (close file)
 (princ (strcat "\nDone writing file " Root "attributes.csv"))
 (princ)
 ) ;defun
;;-------------------------------
(defun List2String  (Alist)
 (setq NumStr (length Alist))
 (foreach Item  AList
   (if (= Item (car AList))
     ;;first item
     (setq LongString (car AList))
     (setq LongString (strcat LongString ";" Item))
     )
   )
 LongString
 ) ;defun
;;--------------------------------
(defun Dxf  (code pairs)
 (cdr (assoc code pairs))
 )
(gattex)

Posted

There are some errors:


    1. The TRANS function expects at least 3 arguments; please check the help and/or my example above.
    2. The DXF code 10 store the X, Y and Z coordinates of block's insertion point - use CAR and CADR or NTH to extract desired coordinates.
    3. DXF code 20 does not exist for your block.
    4. Please pay attention to the location of the insertion point extraction code - the Edata variable store first the block associated list, while down in code is replaced by attributes!
    5. The pointX and pointY are supposed to be atoms, not functions; so cannot be called with paranthesis.
Posted

Get error: ; error: bad argument type: 2D/3D point: nil

 

 ; Global ATTribute EXtractor 
 ; by Miklos Fuccaro mfuccaro@hotmail.com 
 ;-------------------------November 2004 ------- 
;;Edited March 2006 by C. Bassler to allow specification of block and tage names to extract

(defun gattex  ()
 
 (setq Blocklist '("ENG"))
 ;; ** edit to include block names to select
 (setq TagList '("WEIGHT" "LABEL" ))
 ;; ** edit to include tag names to extract
 ;;create block names separated by columns, for selection filter
 (setq Blocknames (List2String BlockList))
 (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 BlockNames))))
 (if (not ss)
   (quit))
 (setq Root (getvar "DWGPREFIX"))
 (setq file (open (strcat Root "attributes.CSV") "w")
       i    -1)
 (repeat (sslength ss)
   (setq TagRow nil
         ValRow nil)
   (setq Edata (entget (setq e (ssname ss (setq i (1+ i))))))
   (while (/= (Dxf 0 Edata) "SEQEND")
     (if
       (and
         (= (Dxf 0 Edata) "ATTRIB")
         (member (dxf 2 Edata) TagList)
         ;;if tag is on list
         ) ;and
        (progn
          (setq TagRow (cons (Dxf 2 Edata) TagRow))
          (setq valRow (cons (Dxf 1 Edata) ValRow))
          ) ;progn
        )
     (setq Edata (entget (setq e (entnext e))))
     ) ;while
   (setq pointIns (trans (cdr (assoc 10 Edata)) 0 1 ))
   (setq valRow (car (pointIns) ValRow))
;   (setq pointIns ( cdr ( pointIns ))) 
;    (setq valRow (car (pointIns) ValRow))


   (write-line (List2String (reverse ValRow)) file)
   ) ;repeat 
 (close file)
 (princ (strcat "\nDone writing file " Root "attributes.csv"))
 (princ)
 ) ;defun
;;-------------------------------
(defun List2String  (Alist)
 (setq NumStr (length Alist))
 (foreach Item  AList
   (if (= Item (car AList))
     ;;first item
     (setq LongString (car AList))
     (setq LongString (strcat LongString ";" Item))
     )
   )
 LongString
 ) ;defun
;;--------------------------------
(defun Dxf  (code pairs)
 (cdr (assoc code pairs))
 )
(gattex)

Posted

Got it to work now! Thanks!:)

 

Only problem I have now is setting the text height. I thought it should be as simple as changing the item marked in bold in code:

 

 (defun c:LSM( / OldLayer OldAttReq layerName pt ans )        ;localize variables to avoid conflicts
  (setq layerName "LS machinery")                   ;use a variable since need in many places
  (setq OldLayer  (getvar "CLAYER")
        OldAttReq (getvar "ATTREQ"))
(if (not (tblsearch "BLOCK" "ENG"))
(progn
 (Command "_ATTDEF" "" "LABEL" "" "" '(0.0 0.0) "[b]50[/b]" "") (setq test1 (entlast))
 (Command "_ATTDEF" "" "WEIGHT" "" "" '(0.0 -1.0) "[b]50[/b]" "") (setq test2 (entlast))
 (command "_-BLOCK" "ENG" '(0.0 0.0) test1 test2 "")
)
)
  (if (and (setq pt (getpoint "\nPick point: "))   ;ensure valid user input
           (setq ans (getstring T "\nEnter label: "))
           (setq wgt (getreal  "\nEnter weight: ")))
   (progn                                          ;PROGN required to group statements
    (if (not (tblsearch "LAYER" layerName))        ;create new layer only if required
     (entmake (list '(0 . "LAYER")
                    '(100 . "AcDbSymbolTableRecord")
                    '(100 . "AcDbLayerTableRecord")
                    '(70 . 0)
                    (cons 2 layerName)
                    '(62 . 5)
                    '(6 . "Continuous")
                    '(290 . 0)
                    '(50 . -3)))
    )
    (setvar "CLAYER" layerName)
    (setvar "ATTREQ" 1)
    ;add the block and fill his two attributes
    (command "_INSERT" "ENG" pt 1.0 1.0 0.0 ans (rtos wgt 2 3))
    (setvar "CLAYER" OldLayer)
    (setvar "ATTREQ" OldAttReq)
   )
  )
  (princ)                                          ;exit the routine quietly
 )

 

Any suggestions regarding how to change this?

Posted

You can provide the height either as string or as real value; same for angle. Your issue seems to be from the fact that you omitted to adjust the attributes relative location on vertical accordingly with the new height of labels:

(Command "_ATTDEF" "" "LABEL" "" ""  '(0.0   0.0) 50.0 0.0) (setq test1 (entlast))
(Command "_ATTDEF" "" "WEIGHT" "" "" '(0.0 [color=red]-55.0[/color]) 50.0 0.0) (setq test2 (entlast))

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...