extracting group name????

how do you export the group name of a line on excel??

i checked all (as in everything!) on dataextraction and nothing there says group

Command: Specify opposite corner:

Command: list

28 found

LINE Layer: "ChCt_ EL 960(ASSAY) 02"

Space: Model space

Handle = 3921

Group = 1000

from point, X=1086.3440 Y=-1442.1871 Z= 960.0000

to point, X=1086.9695 Y=-1443.2810 Z= 960.0000

Length = 1.2601, Angle in XY Plane = 150

Delta X = 0.6255, Delta Y = -1.0939, Delta Z = 0.0000

LINE Layer: "ChCt_ EL 960(ASSAY) 02"

Space: Model space

Handle = 3922

Group = 1000

from point, X=1085.6364 Y=-1440.9190 Z= 960.0000

to point, X=1086.1320 Y=-1441.8325 Z= 960.0000

Length = 1.0392, Angle in XY Plane = 152

Delta X = 0.4956, Delta Y = -0.9134, Delta Z = 0.0000

LINE Layer: "ChCt_ EL 960(ASSAY) 02"

Space: Model space

Press ENTER to continue:

Handle = 3920

Group = 1000

from point, X=1084.6116 Y=-1443.2342 Z= 960.0000

to point, X=1085.0453 Y=-1444.3133 Z= 960.0000

Length = 1.1630, Angle in XY Plane = 158

Delta X = 0.4337, Delta Y = -1.0791, Delta Z = 0.0000

LINE Layer: "ChCt_ EL 960(ASSAY) 02"

Space: Model space

Handle = 391f

Group = 1000

from point, X=1083.9087 Y=-1441.4312 Z= 960.0000

to point, X=1084.3099 Y=-1442.4307 Z= 960.0000

Length = 1.0770, Angle in XY Plane = 158

Delta X = 0.4012, Delta Y = -0.9995, Delta Z = 0.0000

LINE Layer: "ChCt_ EL 960(ASSAY) 02"

Space: Model space

Handle = 391e

Group = 1000

from point, X=1081.9344 Y=-1441.6970 Z= 960.0000

to point, X=1082.2560 Y=-1442.9088 Z= 960.0000

you see?? when i type list, i see the group... how can i extract that to correspond on the XYZ that was extracted

is there a lisp or something that can help me do it??

i found this thread that exports lines and arcs to CSV.

http://www.cadtutor.net/forum/showthread.php?1697-command-list-props

the output was partially what i need.

(defun c:lst( / name file ss ssi enl ln ar c2s)
 ;----------------------------
 (defun ln (l f / s e)    ;To record a LINE l in the file f
   (setq s (cdr (assoc 10 l))    ;Start point
     e (cdr (assoc 11 l)))    ;End point
   (write-line (strcat "LINE," (c2s s) (c2s e) (rtos (distance e s))) f)
   )

 ;----------------------------
; (defun ar (l f / c r s e)            ;To record an ARC
;   (setq c (cdr (assoc 10 l))            ;Center
;     r (cdr (assoc 40 l))            ;Radius
;     s (polar c (cdr (assoc 50 l)) r)    ;Start
;     e (polar c (cdr (assoc 51 l)) r))    ;End
;   (write-line (strcat "ARC," (c2s s) (c2s e) "," (c2s c) (rtos r)) f)
;   )

 ;----------------------------
 (defun c2s (x)    ;Used to transform Coords in String
   (strcat (rtos (car x)) "," (rtos (cadr x)) "," (rtos (caddr x)) ",")
   )
 
 ;----------------------------
 
 (setq name (getvar "dwgname"))
 (if (= "." (substr name (- (strlen name) 3) 1))
   (setq name (substr name 1 (- (strlen name) 4))))
 (setq file (open (getfiled "Output" name "CSV" 1) "w")
   ss (ssget) ssi -1)
 (write-line
   "Typ,Start X,Start Y,Start Z,End X,End Y,EndZ,Length";,cen X,cen Y,cenZ,Radius
   file)
 (repeat (sslength ss)
   (setq enl (entget (ssname ss (setq ssi (1+ ssi)))))
   (cond
     ((= "LINE" (cdr (assoc 0 enl))) (ln enl file))
;      ((= "ARC" (cdr (assoc 0 enl))) (ar enl file))
     )
   )
 (close file)
 (princ)
 )

bu i still needed angle and group name on the output

A start a Group can be accessed

(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for lay (vla-get-Groups doc)(alert (vla-get-name lay))
(vlax-for lay (vla-get-Groups doc)(vlax-dump-object lay))
; when you look at ;   Count (RO) = 4 the 1 object I created is 4 lines.

I have some code somewhere need to find to go next level deeper and get the 4 objects.

bump how is it bigal, did you found it?

I have managed for anyone else interested to do a entget and get the the "group", entget assoc 330 which reveals assoc 340 items which in my case are lines the ones making the group, I just need to step through the 340 codes now and you have an answer.

This works but the ssget is a bit strange, I am sure I had the ssget Group working at work.

(defun c:grprop ( / ss obj x y)
(setq ss (ssget))
(repeat (setq num (sslength ss))
(setq obj (entget (ssname ss (setq num (- num 1)))))
 ;;;;; line
(If (= (cdr (assoc 0 obj)) "LINE")
(progn
(setq pt1 (cdr (assoc 10 obj)))
(setq pt2 (cdr (assoc 11 obj)))
(princ "\nline")(princ pt1)(princ pt2)
) ; progn
) ; if
 ;;;; arc
(If (= (cdr (assoc 0 obj)) "ARC")
(progn
(setq pt1 (cdr (assoc 10 obj)))
(setq rad (cdr (assoc 40 obj)))
(setq ang1 (cdr (assoc 40 obj)))
(setq ang2 (cdr (assoc 40 obj)))
(princ "\narc") (princ pt1)(princ rad)(princ ang1)(princ ang2)
) ; progn
) ; if
) ; repeat
) ; defun
(c:grprop) ; for testing saves typing remove later

Try the following:

(defun c:linex ( / d e f i s )
   (if (and (setq s (ssget '((0 . "LINE"))))
            (setq f (getfiled "" "" "csv" 1))
            (setq d (open f "w"))
       )
       (progn
           (write-line "sx,sy,sz,ex,ey,ez,group" d)
           (repeat (setq i (sslength s))
               (setq e (entget (ssname s (setq i (1- i)))))
               (write-line
                   (LM:lst->str
                       (append
                           (mapcar 'rtos (cdr (assoc 10 e)))
                           (mapcar 'rtos (cdr (assoc 11 e)))
                           (if (and (setq e (member '(102 . "{ACAD_REACTORS") e))
                                    (setq e (member '(102 . "{ACAD_REACTORS") (entget (cdr (assoc 330 e)))))
                                    (setq e (cdr (assoc 3 (entget (cdr (assoc 330 e))))))
                               )
                               (list e)
                           )
                       )
                       ","
                   )
                   d
               )
           )
           (close d)
       )
   )
   (princ)
)

;; List to String  -  Lee Mac
;; Concatenates each string in a supplied list, separated by a given delimiter
;; lst - [lst] List of strings to concatenate
;; del - [str] Delimiter string to separate each item

(defun LM:lst->str ( lst del )
   (if (cdr lst)
       (strcat (car lst) del (LM:lst->str (cdr lst) del))
       (car lst)
   )
)

(princ)

Lee a question why recheck the assoc 102 ? I drew 3 lines then made a group of them, added 1 extra "Line". Used ssget "LINE" using ssname 0-3, I got the following the first 3 co-ords are the "Group", the last the individual line, for ktbjx could add arc, pline etc.

Command: (assoc 10 (cdr (entget (ssname s (setq i (1- i))))))

(10 7774.1 134.857 0.0)

(10 4512.46 4129.59 0.0) (11 8478.87 3671.18 0.0)

(10 8478.87 3671.18 0.0) (11 7774.1 134.857 0.0)

(10 7774.1 134.857 0.0) (11 3594.61 495.038 0.0)

(10 12051.9 3474.72 0.0) (11 12461.7 1018.94 0.0)

Lee a question why recheck the assoc 102 ?

The first member expression verifies that the line is owned by a dictionary (i.e. the Groups dictionary); the second member expression ensures that the owner dictionary (ACAD_GROUP) is obtained from the GROUP entity.

@Lee: I think you have overlooked something:

(if (and (setq e (member '(102 . "{ACAD_REACTORS") e))
        (setq e (member '(102 . "{ACAD_REACTORS") (entget (setq x (cdr (assoc 330 e))))))
        (setq e (cdr (assoc 3 (member (cons 350 x) (reverse (entget (cdr (assoc 330 e))))))))
   )
   (list e)
)

Another issue is that entities can be part of multiple groups.

Try the following:

(defun c:linex ( / d e f i s )
   (if (and (setq s (ssget '((0 . "LINE"))))
            (setq f (getfiled "" "" "csv" 1))
            (setq d (open f "w"))
       )
       (progn
           (write-line "sx,sy,sz,ex,ey,ez,group" d)
           (repeat (setq i (sslength s))
               (setq e (entget (ssname s (setq i (1- i)))))
               (write-line
                   (LM:lst->str
                       (append
                           (mapcar 'rtos (cdr (assoc 10 e)))
                           (mapcar 'rtos (cdr (assoc 11 e)))
                           (if (and (setq e (member '(102 . "{ACAD_REACTORS") e))
                                    (setq e (member '(102 . "{ACAD_REACTORS") (entget (cdr (assoc 330 e)))))
                                    (setq e (cdr (assoc 3 (entget (cdr (assoc 330 e))))))
                               )
                               (list e)
                           )
                       )
                       ","
                   )
                   d
               )
           )
           (close d)
       )
   )
   (princ)
)

;; List to String  -  Lee Mac
;; Concatenates each string in a supplied list, separated by a given delimiter
;; lst - [lst] List of strings to concatenate
;; del - [str] Delimiter string to separate each item

(defun LM:lst->str ( lst del )
   (if (cdr lst)
       (strcat (car lst) del (LM:lst->str (cdr lst) del))
       (car lst)
   )
)

(princ)

Thank you sir for the insit on getting the group name.. now i know how to manipulate it this is a big help

and thanks to this code below, it answers my question and problem on multiple groupings!!!

@Lee: I think you have overlooked something:

(if (and (setq e (member '(102 . "{ACAD_REACTORS") e))
        (setq e (member '(102 . "{ACAD_REACTORS") (entget (setq x (cdr (assoc 330 e))))))
        (setq e (cdr (assoc 3 (member (cons 350 x) (reverse (entget (cdr (assoc 330 e))))))))
   )
   (list e)
)

Another issue is that entities can be part of multiple groups.

This works but the ssget is a bit strange, I am sure I had the ssget Group working at work.

 

(defun c:grprop ( / ss obj x y)
(setq ss (ssget))
(repeat (setq num (sslength ss))
(setq obj (entget (ssname ss (setq num (- num 1)))))
 ;;;;; line
(If (= (cdr (assoc 0 obj)) "LINE")
(progn
(setq pt1 (cdr (assoc 10 obj)))
(setq pt2 (cdr (assoc 11 obj)))
(princ "\nline")(princ pt1)(princ pt2)
) ; progn
) ; if
 ;;;; arc
(If (= (cdr (assoc 0 obj)) "ARC")
(progn
(setq pt1 (cdr (assoc 10 obj)))
(setq rad (cdr (assoc 40 obj)))
(setq ang1 (cdr (assoc 40 obj)))
(setq ang2 (cdr (assoc 40 obj)))
(princ "\narc") (princ pt1)(princ rad)(princ ang1)(princ ang2)
) ; progn
) ; if
) ; repeat
) ; defun
(c:grprop) ; for testing saves typing remove later

and thanks also to bigal for pointing out SSGET, didnt thought its that powerful to use it on getting the properties of a line!

all you guys are so helpful!

@Lee: I think you have overlooked something

Good catch Roy, thanks.

Try the following:

(defun c:linex ( / d e f i s )
   (if (and (setq s (ssget '((0 . "LINE"))))
            (setq f (getfiled "" "" "csv" 1))
            (setq d (open f "w"))
       )
       (progn
           (write-line "sx,sy,sz,ex,ey,ez,group" d)
           (repeat (setq i (sslength s))
               (setq e (entget (ssname s (setq i (1- i)))))
               (write-line
                   (LM:lst->str
                       (append
                           (mapcar 'rtos (cdr (assoc 10 e)))
                           (mapcar 'rtos (cdr (assoc 11 e)))
                           (if (and (setq e (member '(102 . "{ACAD_REACTORS") e))
                                    (setq e (member '(102 . "{ACAD_REACTORS") (entget (cdr (assoc 330 e)))))
                                    (setq e (cdr (assoc 3 (entget (cdr (assoc 330 e))))))
                               )
                               (list e)
                           )
                       )
                       ","
                   )
                   d
               )
           )
           (close d)
       )
   )
   (princ)
)

;; List to String  -  Lee Mac
;; Concatenates each string in a supplied list, separated by a given delimiter
;; lst - [lst] List of strings to concatenate
;; del - [str] Delimiter string to separate each item

(defun LM:lst->str ( lst del )
   (if (cdr lst)
       (strcat (car lst) del (LM:lst->str (cdr lst) del))
       (car lst)
   )
)

(princ)

Question, how will i add the distance and angle of the line???

(mapcar 'rtos (cdr (assoc 10 e)))
(mapcar 'rtos (cdr (assoc 11 e)))

To get the angle and distance

(setq pt1 (cdr (assoc 10 e)))
(setq pt2 (cdr (assoc 11 e)))
(setq ang (angle pt1 pt2))
(setq dist (distance pt1 pt2)) 
(mapcar 'rtos pt1) 
(mapcar 'rtos pt2)

To get the angle and distance

 

(setq pt1 (cdr (assoc 10 e)))
(setq pt2 (cdr (assoc 11 e)))
(setq ang (angle pt1 pt2))
(setq dist (distance pt1 pt2)) 
(mapcar 'rtos pt1) 
(mapcar 'rtos pt2)

Select objects: ; error: bad argument type: listp 3.60371

(defun c:LineExtration ( / d e f i s q1 q2 x pt1 pt2 ang dist)
   (if (and (setq s (ssget '((0 . "LINE"))))
            (setq f (getfiled "" "" "csv" 1))
            (setq d (open f "w"))
       )
       (progn
           (write-line "Start X,Start Y,Start Z,End X,End Y,End Z,Group" d)
           (repeat (setq i (sslength s))
               (setq e (entget (ssname s (setq i (1- i)))))




               (write-line
                   (LM:lst->str
                       (append
                           (mapcar 'rtos (cdr (assoc 10 e)))
                           (mapcar 'rtos (cdr (assoc 11 e)))
(setq pt1 (cdr (assoc 10 e)))
(setq pt2 (cdr (assoc 11 e)))
(setq ang (angle pt1 pt2))
(setq dist (distance pt1 pt2)) 
(mapcar 'rtos ang) 
(mapcar 'rtos dist)

                           (if (and (setq e (member '(102 . "{ACAD_REACTORS") e))
                                   (setq e (member '(102 . "{ACAD_REACTORS") (entget (setq x (cdr (assoc 330 e))))))
                                   (setq e (cdr (assoc 3 (member (cons 350 x) (reverse (entget (cdr (assoc 330 e))))))))
                               )

   


   
                           (list e)
                           )
                       )
                       ","
                   )
                   d
               )
           )
           (close d) ;09174262900
       )
   )
   (princ)
)

(defun LM:lst->str ( lst del )
   (if (cdr lst)
       (strcat (car lst) del (LM:lst->str (cdr lst) del))
       (car lst)
   )
)

(princ)

LOL i manage to add the LENGTH and ANGLE but it writes on another row!

can someone look what im doing wrong???

(defun c:linex ( / d e f i s )
   (if (and (setq s (ssget '((0 . "LINE"))))
            (setq f (getfiled "" "" "csv" 1))
            (setq d (open f "w"))
       )
       (progn
           (write-line "sx,sy,sz,ex,ey,ez,group" d)
           (repeat (setq i (sslength s))
               (setq e (entget (ssname s (setq i (1- i))))
spt (cdr (assoc 10 e))
ept (cdr (assoc 11 e))
)

(write-line
                       (strcat
                           (rtos (distance spt ept)) ","
                           (angtos  (angle spt ept)) ","
) d)
               (write-line


                   (LM:lst->str
                       (append
                           (mapcar 'rtos (cdr (assoc 10 e)))
                           (mapcar 'rtos (cdr (assoc 11 e)))
                           (if (and (setq e (member '(102 . "{ACAD_REACTORS") e))
                           (setq e (member '(102 . "{ACAD_REACTORS") (entget (setq x (cdr (assoc 330 e))))))
                        (setq e (cdr (assoc 3 (member (cons 350 x) (reverse (entget (cdr (assoc 330 e))))))))
                       )
                       
(list e)
                   )
                       )
                       ","
                   )


                   d
               )
           )
           (close d)
       )
   )
   (princ)
)

(defun LM:lst->str ( lst del )
   (if (cdr lst)
       (strcat (car lst) del (LM:lst->str (cdr lst) del))
       (car lst)
                       
   )
)

(princ)

You have two write-line so will be two lines.

Need to move the dist and ang part not tested

(strcat
                           (rtos (distance spt ept)) ","
                           (angtos  (angle spt ept)) ","

(LM:lst->str
.........
.......
) ; for new strcat at end of LM:lst->str need to count brackets.

; OR put dist ang at end before new strcat
(Strcat 
(LM:lst->str..............
..........
                           (rtos (distance spt ept)) ","
                           (angtos  (angle spt ept)) ","
)

(defun c:LINEEXTRACTION ( / d e f i s spt ept)
   (if (and (setq s (ssget '((0 . "LINE"))))
            (setq f (getfiled "" "" "CSV" 1))
            (setq d (open f "w"))
       )
       (progn
           (write-line "Start X,Start Y,Start Z,End X,End Y, End Z,Group,Length,Angle" d)
           (repeat (setq i (sslength s))
               (setq e (entget (ssname s (setq i (1- i))))
spt (cdr (assoc 10 e))
ept (cdr (assoc 11 e))
)
               (write-line
                   (LM:lst->str
                       (append
                           (mapcar 'rtos (cdr (assoc 10 e)))
                           (mapcar 'rtos (cdr (assoc 11 e)))
                           (if (and (setq e (member '(102 . "{ACAD_REACTORS") e))
                           (setq e (member '(102 . "{ACAD_REACTORS") (entget (setq x (cdr (assoc 330 e))))))
                        (setq e (cdr (assoc 3 (member (cons 350 x) (reverse (entget (cdr (assoc 330 e))))))))
                       )
                           (list e)
                   )
                       )
                       ","
                   )
                   d
               )
           )
           (close d)
       )
   )

(prompt "DONE!")
(princ)
)

(defun LM:lst->str ( lst del )
   (if (cdr lst)
       (strcat (car lst) del (LM:lst->str (cdr lst) del)
       ","
   (rtos (distance spt ept)) ","
       (angtos  (angle spt ept))
       )                    
       (car lst)
   )
)
   (princ)

i got it work,

but it repeats the length and angle 5 times but its all good, ill just have to delete it

On 8/23/2016 at 11:23 AM, ktbjx said:

 

(defun c:LINEEXTRACTION ( / d e f i s spt ept)
   (if (and (setq s (ssget '((0 . "LINE"))))
            (setq f (getfiled "" "" "CSV" 1))
            (setq d (open f "w"))
       )
       (progn
           (write-line "Start X,Start Y,Start Z,End X,End Y, End Z,Group,Length,Angle" d)
           (repeat (setq i (sslength s))
               (setq e (entget (ssname s (setq i (1- i))))
spt (cdr (assoc 10 e))
ept (cdr (assoc 11 e))
)
               (write-line
                   (LM:lst->str
                       (append
                           (mapcar 'rtos (cdr (assoc 10 e)))
                           (mapcar 'rtos (cdr (assoc 11 e)))
                           (if (and (setq e (member '(102 . "{ACAD_REACTORS") e))
                           (setq e (member '(102 . "{ACAD_REACTORS") (entget (setq x (cdr (assoc 330 e))))))
                        (setq e (cdr (assoc 3 (member (cons 350 x) (reverse (entget (cdr (assoc 330 e))))))))
                       )
                           (list e)
                   )
                       )
                       ","
                   )
                   d
               )
           )
           (close d)
       )
   )

(prompt "DONE!")
(princ)
)

(defun LM:lst->str ( lst del )
   (if (cdr lst)
       (strcat (car lst) del (LM:lst->str (cdr lst) del)
       ","
   (rtos (distance spt ept)) ","
       (angtos  (angle spt ept))
       )                    
       (car lst)
   )
)
   (princ)

 

 

Hello Autolisp Experts!

First off, this routine is very usefull to us, and we still use this upto now..

but now that we are adding more to our datas, and using more softwares. we noticed that the CSV file generated by this routine wont recognize the coordinates.

and we found out that if we save the CSV file into xls file and then change all the coordinates with this formula (=TEXT,A2,"0000,0000") in excel, the software we use, recognizes the coordinates!

further more, CSV removes the excess ZEROS, we need it to be always 4 decimals

I tried changing the code to xlsx but i have no luck!

maybe someone could help me change this routine to export from CSV to XLSX?

If you want 123.0000 look into "padding text" it is here just have to find.

Depending on where you are in the world excel uses a period . or a comma for decimal seperation you can set excel I think to say comma seperator import csv then set it to comma decimal so should change values. Other way is use tab as seperator rather than comma it can still be called csv. 

replace 

","

(chr 9)