Creating macro for transporting coordinates to excel/textfile

[Technick]

Tried CSV file, but still gets problem with the text that has a space between the words. One word will end in column B and one in column C, which also lead to coordinates moved to wrong column (compared to the other objects which only have one word in description). This could be solved if it was possible to tell autocad to put the text in one column, x in one column and y in one column (sorry for my bad explanation!)

[MSasu]

What separator did you used for data? Should use "," or ";" (check in Control Panel --> Regional and Language Options --> Regional Options --> Customize --> Numbers --> List separator).

(if (setq setTexts (ssget "_X" '((0 . "TEXT") (8 . "Coordinates"))))
(progn
[color=magenta]  (setq fileObj (open "C:\\MyDumpFile.CSV" "w"))[/color]
 (setq index 0)
 (repeat (sslength setTexts)
  (setq itemText (entget (ssname setTexts index)))
  ([color=magenta]write-line[/color] (strcat "Point " (cdr (assoc 1 itemText))
                      [color=magenta]","[/color] (rtos (cadr   (assoc 10 itemText)) 2 5)
                      [color=magenta]","[/color] (rtos (caddr  (assoc 10 itemText)) 2 5)
                      [color=magenta]","[/color] (rtos (cadddr (assoc 10 itemText)) 2 5)) [color=magenta]fileObj[/color])
  (setq index (1+ index))
 )
[color=magenta]  (setq fileObj (close fileObj))[/color]
)
)

[Technick]

";" is used as separator, so I changed routine to:

 

(if (setq setTexts (ssget "_X" '((0 . "TEXT") (8 . "Coordinates"))))
(progn
 (setq fileObj (open "C:\\MyDumpFile.CSV" "w"))
 (setq index 0)
 (repeat (sslength setTexts)
  (setq itemText (entget (ssname setTexts index)))
  (write-line (strcat (cdr (assoc 1 itemText))
                      ";" (rtos (cadr   (assoc 10 itemText)) 2 5)
                      ";" (rtos (caddr  (assoc 10 itemText)) 2 5)) fileObj)
  (setq index (1+ index))
 )
 (setq fileObj (close fileObj))
)
)

 

Now it works excellent, except one thing: The coordinates it gets does not refer to UCS coordinate system I set. Is it possible to make it use the given USC coordinate system?

 

And again: I am so thankful that you are helping me with this!

[MSasu]

The coordinates it gets does not refer to UCS coordinate system I set. Is it possible to make it use the given USC coordinate system?

For sure is possible, please take a look to TRANS function.

 

And again: I am so thankful that you are helping me with this!

Anytime. You are entirely welcome!

[Technick]

I tried adding the following to the macro:

.....
(if (and (setq pt (getpoint "\nPick point: "))   ;ensure valid user input
   (setq cs_from 0) ; WCS
   (setq cs_to 1) ; UCS
   (trans pt cs_from cs_to 0) ; disp = 0 indicates that pt is a point
       (setq ans (getstring T "\nEnter label: ")))
 (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)))
........
  )

 

It still refers to WCS in CSV file. Any suggestions?

[MSasu]

Please keep in mind that on associated lists the points are retained in WCS coordinates; that’s it, no matter you add/edit an entity using ENTMAKE/ENTMAKEX/ENTMOD or extract his features with ENTGET.

However when use COMMAND function, the coordinates are UCS ones.

 

 

For your case, report to UCS coordinates when add the labels and take care that the one you extract are in WCS. So, adjust them accordingly with TRANS.

[Lee Mac]

Please keep in mind that on associated lists the points are retained in WCS coordinates; that’s it, no matter you add/edit an entity using ENTMAKE/ENTMAKEX/ENTMOD or extract his features with ENTGET.

 

A minor clarification for those following the thread: whilst for non-planar objects (3D-Polyline / 3D-Face / Line / Point) the DXF point data is indeed defined in WCS; for planar objects (Text / LWPolyline / Arc / Circle / Spline / Insert / 2D-Polyline / Hatch / Attrib / Attdef / Solid / Trace / Ellipse etc), the DXF point data is defined in OCS (Object Coordinate System / a.k.a. ECS), that is, relative to the coordinate system defined by the application of the Arbitrary Axis Algorithm on the Normal vector (DXF 210) of the plane in which the entity resides.

 

There are some exceptions to this rule: for example, MText is a planar object but has points defined in WCS; similarly a Viewport is planar but defined in WCS; and Dimensions have a mixture of WCS and OCS points.

[Technick]

Sorry, I think I need to be spoon fed with regards to the TRANS function:oops: Not so good with the programming...

[Technick]

One more question: Is it possible to implement in the macro below a way to create a second label that would be inserted next to the first?

 

(defun c:LSM( / OldLayer layerName pt ans )        ;localize variables to avoid conflicts
(setq layerName "LS machinery")                   ;use a variable since need in many places
(setq OldLayer (getvar "CLAYER"))
(if (and (setq pt (getpoint "\nPick point: "))   ;ensure valid user input
         (setq ans (getstring T "\nEnter label: ")))
 (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)
  (command "_text" pt 1.0 0 ans)                 ;underscore ensure compatibility
  (setvar "CLAYER" OldLayer)
 )
)
(princ)                                          ;exit the routine quietly
)

 

 

Example:

1. Running macro

2. Picking point

3.Enter label: Engine

4. Program ask: Weight? User input value for example 32

 

Then I run the second macro:

 

(defun c:ToExcel()
(if (setq setTexts (ssget "_X" '((0 . "TEXT") (8 . "LS machinery"))))
(progn
 (setq fileObj (open "C:\\LS machinery.CSV" "w"))
 (setq index 0)
 (repeat (sslength setTexts)
  (setq itemText (entget (ssname setTexts index)))
  (write-line (strcat (cdr (assoc 1 itemText))
                      ";" (rtos (cadr   (assoc 10 itemText)) 2 5)
                      ";" (rtos (caddr  (assoc 10 itemText)) 2 5)) fileObj)
  (setq index (1+ index))
 )
 (setq fileObj (close fileObj))
)
)
)

 

Output in excel should be:

 

|Engine|32|X|Y|

 

(for x and y it would be nice if output was divided by 1000 (convert to meter))

 

Sorry for testing your patiance, but this would really help me in my work! Thanks!

[MSasu]

That second prompt is compulsory or optional? Is somehow related to the first one? I mean ask for weight only if first input is "Engine", and not if is "xyz".

[Technick]

It is compulsory. |Name of item| Weight of item| x position in meter | y position in meter |.

[MSasu]

Regarding the conversion to meters:

(write-line (strcat (cdr (assoc 1 itemText))
                   ";" (rtos [color=blue](/ [/color](cadr   (assoc 10 itemText)) [color=blue]1000.0)[/color] 2 5)             ; X coordinate
                   ";" (rtos [color=blue](/ [/color](caddr  (assoc 10 itemText))[color=blue] 1000.0)[/color] 2 5)) fileObj)   ; Y coordinate

[Technick]

Nice! Thanks!

[MSasu]

You're welcome!

 

 

Have added for you two more lines to interogate for weight and place a new record below label; I suggest you to look for POLAR and RTOS fuction to adjust my example to suit your needs. You may also want to add the weight note into a different layer or filter it out at extraction.

(defun c:LSM( / OldLayer layerName pt ans )        ;localize variables to avoid conflicts
(setq layerName "LS machinery")                   ;use a variable since need in many places
(setq OldLayer (getvar "CLAYER"))
(if (and (setq pt (getpoint "\nPick point: "))   ;ensure valid user input
         (setq ans (getstring T "\nEnter label: "))
         [color=blue](setq wgt (getreal  "\nEnter weight: "))[/color])
 (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)
  (command "_text" pt 1.0 0 ans)                 ;underscore ensure compatibility
[color=blue]   (command "_text" (polar pt (* 1.5 pi) 1.0 ) 0.5 0 (rtos wgt 2 3))   ;record the weight[/color]
  (setvar "CLAYER" OldLayer)
 )
)
(princ)                                          ;exit the routine quietly
)

[Technick]

Got a problem with that one:

 

Output in excel will be weight on one row with X and Y. Label will go to next row:

 

Weight|X|Y

Name|X|Y

 

It should have been just one row with:

Name|Weight|X|Y

[MSasu]

So, you are looking to extract the pair of Label and Weight? I was under impression that you need to extract only the Label.

[Technick]

Sorry for bad explanation! I want to extract both Label and Weight yes!

[MSasu]

Then, you should group those two text items together somehow. I suggest you to look for a block with attributes instead of two text labels.

To extract those blocks check the EATTEXT command.

[MSasu]

I have changed again your code to work with a block with attributes instead of text items. The below presume that you will have a block named ENG inside your drawing and this block had two attributes: LABEL and WEIGHT.

 (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
    (alert "ENG block isn't available!")
    (exit)
   )
  )
  (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
 ) 

For sure this code is just a simple example and can be refined more.

[Technick]

Nice! Is it possible to create a macro so that it is automatically creating the block ENG with the attributes label and weight, or do I have to do that manually in each drawing?

 

Also if it's possible to make the below code take block and not the text items:

(defun c:ToExcel()
(if (setq setTexts (ssget "_X" '((0 . "TEXT") (8 . "LS machinery"))))
(progn
 (setq fileObj (open "C:\\LS machinery.CSV" "w"))
 (setq index 0)
 (repeat (sslength setTexts)
  (setq itemText (entget (ssname setTexts index)))
  (write-line (strcat (cdr (assoc 1 itemText))
                      ";" (rtos (cadr   (assoc 10 itemText)) 2 5)
                      ";" (rtos (caddr  (assoc 10 itemText)) 2 5)) fileObj)
  (setq index (1+ index))
 )
 (setq fileObj (close fileObj))
)
)