I Need some help, Creating Table with Layer Name from Specific Section

[Michalis]

Hello everyone,

im a new guy here and i need some help,

I want to draw a line, (its kind of Section) and then should generate a table with polylines or lines Layer with Count, that pass through, i've done that with Mechanical using Section and with dx, but i need it faster with lisp, i could use table, or block so when i insert it should need first point, then 2nd point and would give me all layer names in a box with count,

forgive me for my english,

please see image below

[Tharwat]

Welcome to Cadtutor

 

 

What is the section is about ? and what is it consist of ?

 

And it would much more clearer for all if you show the table in English language

 

Can you upload a drawing of that section ?

[Michalis]

you are right, this is a new Screenshot translated in English,

the story goes like this,

im using Layer name for each cable that i use, for instance, NYY 5x10mm2 is the Layer name and the NYY 5x10mm2 also,

from A-B according to my draw, i have many cables, 9FTP Cat5 1NYY 5x10, 1NYY 3x120+70 + 1x90mm2 2NYY 5x16 etc etc, so, i want to select 2points (A-B) for instance,

the 2nd image show all the lines that pass through 2points (model space), so now i have to work this from manhole to manhole to illustrate to the guys at the work site and inform them how the piping will be done,

 

the section is a simple polyline, crossing the other polylines,

 

[Lee Mac]

This should get you started:

 

([color=BLUE]defun[/color] c:LineCount ( [color=BLUE]/[/color] a b i l p q s )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]setq[/color] p ([color=BLUE]getpoint[/color] [color=MAROON]"\nPick 1st Point: "[/color]))
           ([color=BLUE]setq[/color] q ([color=BLUE]getpoint[/color] [color=MAROON]"\nPick 2nd Point: "[/color] p))
       )
       ([color=BLUE]if[/color] ([color=BLUE]setq[/color] s ([color=BLUE]ssget[/color] [color=MAROON]"_F"[/color] ([color=BLUE]list[/color] p q) '((0 . [color=MAROON]"*LINE"[/color]))))
           ([color=BLUE]progn[/color]
               ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
                   ([color=BLUE]setq[/color] a ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 8 ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] s ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i)))))))
                   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] b ([color=BLUE]assoc[/color] a l))
                       ([color=BLUE]setq[/color] l ([color=BLUE]subst[/color] ([color=BLUE]list[/color] a ([color=BLUE]1+[/color] ([color=BLUE]cadr[/color] b))) b l))
                       ([color=BLUE]setq[/color] l ([color=BLUE]cons[/color]  ([color=BLUE]list[/color] a 1) l))
                   )
               )
               ([color=BLUE]terpri[/color])
               ([color=BLUE]princ[/color] (LM:PadBetween [color=MAROON]"\nLayer"[/color] [color=MAROON]"Count"[/color] [color=MAROON]"."[/color] 40))
               ([color=BLUE]princ[/color] (LM:PadBetween [color=MAROON]"\n"[/color] [color=MAROON]""[/color] [color=MAROON]"="[/color] 40))
               ([color=BLUE]foreach[/color] x ([color=BLUE]vl-sort[/color] l '([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]<[/color] ([color=BLUE]cadr[/color] a) ([color=BLUE]cadr[/color] b))))
                   ([color=BLUE]princ[/color] (LM:PadBetween ([color=BLUE]strcat[/color] [color=MAROON]"\n "[/color] ([color=BLUE]car[/color] x)) ([color=BLUE]itoa[/color] ([color=BLUE]cadr[/color] x)) [color=MAROON]"."[/color] 40))
               )
               ([color=BLUE]textpage[/color])
           )
           ([color=BLUE]princ[/color] [color=MAROON]"\nNo lines found between selected points."[/color])
       )
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];;---------------------=={ Pad Between }==--------------------;;[/color]
[color=GREEN];;                                                            ;;[/color]
[color=GREEN];;  Returns a string of a minimum specified length which is   ;;[/color]
[color=GREEN];;  the concatenation of two supplied strings padded to a     ;;[/color]
[color=GREEN];;  desired length using a supplied character.                ;;[/color]
[color=GREEN];;------------------------------------------------------------;;[/color]
[color=GREEN];;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;[/color]
[color=GREEN];;------------------------------------------------------------;;[/color]
[color=GREEN];;  Arguments:                                                ;;[/color]
[color=GREEN];;  s1,s2 - strings to be concatenated                        ;;[/color]
[color=GREEN];;  ch    - character for padding                             ;;[/color]
[color=GREEN];;  ln    - minimum length of returned string                 ;;[/color]
[color=GREEN];;------------------------------------------------------------;;[/color]
[color=GREEN];;  Returns:  Concatenation of s1,s2 padded to a min length   ;;[/color]
[color=GREEN];;------------------------------------------------------------;;[/color]

([color=BLUE]defun[/color] LM:PadBetween ( s1 s2 ch ln )
   (
       ([color=BLUE]lambda[/color] ( a b c )
           ([color=BLUE]repeat[/color] ([color=BLUE]-[/color] ln ([color=BLUE]length[/color] b) ([color=BLUE]length[/color] c)) ([color=BLUE]setq[/color] c ([color=BLUE]cons[/color] a c)))
           ([color=BLUE]vl-list->string[/color] ([color=BLUE]append[/color] b c))
       )
       ([color=BLUE]ascii[/color] ch)
       ([color=BLUE]vl-string->list[/color] s1)
       ([color=BLUE]vl-string->list[/color] s2)
   )
)

[Michalis]

Love it!

but..!! :-)

how can i have the points that i selected, to be shown at the draw? so i want to show from which point i found this data?

 

its kinda report of polylines passing through the points i decide, i wish i can give you more examples now im at work and im thinking on how to make it from early morning!!!

[Tharwat]

My version and my way ....

 

(defun c:Test (/ entities i number integer layers lst object point1
              point2 result selectionset selectionsetname singlelayer
             )
 ;;; Tharwat 15. May. 2012 ;;;
 (if (and (setq point1 (getpoint "\n Specify first point :"))
          (setq point2 (getpoint point1 "\n Specify Second point :"))
          (setq selectionset
                 (ssget "_F"
                        (list point1 point2)
                        '((0 . "LINE,*POLYLINE"))
                 )
          )
     )
   (progn
     (repeat (setq integer (sslength selectionset))
       (setq entities (cons (setq selectionsetname
                                   (ssname
                                     selectionset
                                     (setq integer (1- integer))
                                   )
                            )
                            entities
                      )
       )
       (if (not (member (setq singlelayer
                               (cdr (assoc 8 (entget selectionsetname)))
                        )
                        layers
                )
           )
         (setq layers (cons singlelayer layers))
       )
     )
     (setq i 0)
     (foreach layer layers
       (repeat (setq number (length entities))
         (if
           (eq
             (cdr
               (assoc 8
                      (entget (nth (setq number (1- number)) entities))
               )
             )
             layer
           )
            (setq lst (cons layer (setq i (1+ i))))
         )
       )
       (setq result (cons lst result))
       (setq i 0)
     )
   )
 )
 (foreach one (reverse result)
   (print one)
 )
 (textpage)
 (princ)
)

[Tharwat]

This one is much more better with a table .

 

(defun c:Test (/ entities i number integer layers lst object point1 p
              height point2 result selectionset selectionsetname
              singlelayer model table r c inc
             )
 (vl-load-com)
;;; Tharwat 15. May. 2012 ;;;
 (if (and (setq point1 (getpoint "\n Specify first point :"))
          (setq point2 (getpoint point1 "\n Specify Second point :"))
          (setq selectionset
                 (ssget "_F"
                        (list point1 point2)
                        '((0 . "LINE,*POLYLINE"))
                 )
          )

          (setq p (getpoint "\n Table insertion point :"))
     )
   (progn
     (setq height (if (zerop (cdr (assoc 40
                                         (setq st
                                                (entget
                                                  (tblobjname "STYLE" (getvar 'textstyle))
                                                )
                                         )
                                  )
                             )
                      )
                    (cdr (assoc 42 st))
                    (cdr (assoc 40 st))
                  )
     )
     (repeat (setq integer (sslength selectionset))
       (setq entities (cons (setq selectionsetname
                                   (ssname
                                     selectionset
                                     (setq integer (1- integer))
                                   )
                            )
                            entities
                      )
       )
       (if (not (member (setq singlelayer
                               (cdr (assoc 8 (entget selectionsetname)))
                        )
                        layers
                )
           )
         (setq layers (cons singlelayer layers))
       )
     )
     (setq i 0)
     (foreach layer layers
       (repeat (setq number (length entities))
         (if
           (eq
             (cdr
               (assoc 8
                      (entget (nth (setq number (1- number)) entities))
               )
             )
             layer
           )
            (setq lst (cons layer (setq i (1+ i))))
         )
       )
       (setq result (cons lst result))
       (setq i 0)
     )
     (setq model (vla-get-modelspace
                   (vla-get-activedocument (vlax-get-acad-object))
                 )
     )
     (setq table (vla-addtable
                   model
                   (vlax-3d-point p)
                   (1+ (length result))
                   2
                   (* height 2.)
                   (* height 10.)
                 )
     )
     (vla-settext table 0 0 "Section A - B")
     (setq r   0
           c   0
           inc -1
     )
     (repeat (length result)
       (vla-settext
         table
         (setq r (1+ r))
         c
         (car (nth (setq inc (1+ inc)) result))
       )
       (vla-settext
         table
         r
         (setq c (1+ c))
         (itoa (cdr (nth inc result)))
       )
       (setq c 0)
     )
   )
 )
 (princ)
)

[fixo]

In addition to first code:

 
(defun c:LineCount ( / a acsp adoc b col cols i ip l num p q row rows s tbl tmp)
(vl-load-com)
(if
(and
(setq p (getpoint "\nPick 1st Point: "))
(setq q (getpoint "\nPick 2nd Point: " p))
)
(if (setq s (ssget "_F" (list p q) '((0 . "*LINE"))))
(progn
(repeat (setq i (sslength s))
(setq a (cdr (assoc 8 (entget (ssname s (setq i (1- i)))))))
(if (setq b (assoc a l))
(setq l (subst (list a (1+ (cadr b))) b l))
(setq l (cons (list a 1) l))
)
)

(setq adoc (vla-get-activedocument (vlax-get-acad-object))
acsp (vla-get-block (vla-get-activelayout adoc))
) 
(setq l (vl-sort l '(lambda ( a b ) (< (cadr a) (cadr b)))))
(setq l (mapcar 'reverse l))
(setq ip (getpoint "\nPick table position: "))
(setq tbl (vlax-invoke acsp 'addtable ip (+ (length l) 1) (length (car l)) 25.0 250.0))

(vla-put-regeneratetablesuppressed tbl :vlax-true)

(vla-settext tbl 0 0 "Section [url="file://c3;a-b/"]\\C3;A-B[/url]")

(setq row 1)
(setq num (length l))

(setq cols (length (car l)))

(foreach x l 
(setq tmp (car l))
(setq col 0)
(while (< col cols)
(vla-settext tbl row col (nth col x))
(setq col (1+ col))
)
(setq row (1+ row))
)

(setq rows (vla-get-rows tbl))

(vla-settextheight tbl actitlerow 20)

(vla-settextheight tbl (+ acheaderrow acdatarow) 15)

(vla-setcolumnwidth tbl 0 50.)

(vla-setcolumnwidth tbl 1 150.)

(vla-put-regeneratetablesuppressed tbl :vlax-false))
)
(princ "\nNo lines found between selected points.")
)
(princ)
)

 

~'J'~

Edited May 16, 2012 by fixo

[Michalis]

Im bigger Newbie than you think

i loaded the code but i dont know how to use it in command line, i write Test from defun C:Test but there is no such Command, how should i run it?

 

Thank you all for your help, you all rock hard and i wish i could do something for you also,

 

This one is much more better with a table .

 

(defun c:Test (/ entities i number integer layers lst object point1 p
              height point2 result selectionset selectionsetname
              singlelayer model table r c inc
             )
 (vl-load-com)
;;; Tharwat 15. May. 2012 ;;;
 (if (and (setq point1 (getpoint "\n Specify first point :"))
          (setq point2 (getpoint point1 "\n Specify Second point :"))
          (setq selectionset
                 (ssget "_F"
                        (list point1 point2)
                        '((0 . "LINE,*POLYLINE"))
                 )
          )

          (setq p (getpoint "\n Table insertion point :"))
     )
   (progn
     (setq height (if (zerop (cdr (assoc 40
                                         (setq st
                                                (entget
                                                  (tblobjname "STYLE" (getvar 'textstyle))
                                                )
                                         )
                                  )
                             )
                      )
                    (cdr (assoc 42 st))
                    (cdr (assoc 40 st))
                  )
     )
     (repeat (setq integer (sslength selectionset))
       (setq entities (cons (setq selectionsetname
                                   (ssname
                                     selectionset
                                     (setq integer (1- integer))
                                   )
                            )
                            entities
                      )
       )
       (if (not (member (setq singlelayer
                               (cdr (assoc 8 (entget selectionsetname)))
                        )
                        layers
                )
           )
         (setq layers (cons singlelayer layers))
       )
     )
     (setq i 0)
     (foreach layer layers
       (repeat (setq number (length entities))
         (if
           (eq
             (cdr
               (assoc 8
                      (entget (nth (setq number (1- number)) entities))
               )
             )
             layer
           )
            (setq lst (cons layer (setq i (1+ i))))
         )
       )
       (setq result (cons lst result))
       (setq i 0)
     )
     (setq model (vla-get-modelspace
                   (vla-get-activedocument (vlax-get-acad-object))
                 )
     )
     (setq table (vla-addtable
                   model
                   (vlax-3d-point p)
                   (1+ (length result))
                   2
                   (* height 2.)
                   (* height 10.)
                 )
     )
     (vla-settext table 0 0 "Section A - B")
     (setq r   0
           c   0
           inc -1
     )
     (repeat (length result)
       (vla-settext
         table
         (setq r (1+ r))
         c
         (car (nth (setq inc (1+ inc)) result))
       )
       (vla-settext
         table
         r
         (setq c (1+ c))
         (itoa (cdr (nth inc result)))
       )
       (setq c 0)
     )
   )
 )
 (princ)
)

[Tharwat]

type Vlide at the command line then start a new file from that application then Copy the code and Paste it in the new file then save the file in the location that you want to and then go back to Autocad and type the command appload and then select the file that you have just saved and when you finish just type test to start the routine

[Michalis]

some things are in front of us and we just cant see it!!

 

i was at vlide but for some reason i thought i had to debug it or... make it lisp into lisp thing..

 

thank you!! it really works!!

[Tharwat]

some things are in front of us and we just cant see it!!

 

i was at vlide but for some reason i thought i had to debug it or... make it lisp into lisp thing..

 

thank you!! it really works!!

 

Happy to hear that .

 

Enjoy it Michalis

[Michalis]

Dear friends, lets make it harder

 

it should be great when i use the code for 2nd time, the A-B to be done C-E and then F-G etc..etc..

Also, the 2 points that i specify should leave me a polyline and a name above them with the Section Name, for example

if i run it first time, i Specify 1st point, then 2nd point,

the result should be,

A polyline From 1st point to 2nd Point with A-B letters above each point, and the table is great as it is,

Then, when i should run it for 2nd time, i would specify again 1st point then 2nd point and the result sould be:

A polyline from 1st point to 2nd point with C-D letters above,

i dont know if its possible for the Arrows to be done, at the Line where the Points where selected at the beginning of the process (1st point 2nd point for each time i run the lsp)

 

im sure its piece of cake for you guys

[Tharwat]

Dear friends, lets make it harder

 

it should be great when i use the code for 2nd time, the A-B to be done C-E and then F-G etc..etc..

Also, the 2 points that i specify should leave me a polyline and a name above them with the Section Name, for example

if i run it first time, i Specify 1st point, then 2nd point,

the result should be,

A polyline From 1st point to 2nd Point with A-B letters above each point, and the table is great as it is,

Then, when i should run it for 2nd time, i would specify again 1st point then 2nd point and the result sould be:

A polyline from 1st point to 2nd point with C-D letters above,

i dont know if its possible for the Arrows to be done, at the Line where the Points where selected at the beginning of the process (1st point 2nd point for each time i run the lsp)

 

im sure its piece of cake for you guys

 

It is not a piece of cake at all for me at least

 

Try to specify the first point on the right hand side and the second one on the left side hand to avoid the orientation of the texts ' angles .

 

(defun c:Test (/ entities i number integer layers lst object point1 p st
              height point2 result selectionset selectionsetname
              singlelayer space table r c inc ang
             )
 (vl-load-com)
;;; Tharwat 15. May. 2012 ;;;
 (if (not char1)
   (setq char1 65
         char2 66
   )
   (setq char1 (+ char1 2)
         char2 (+ char2 2)
   )
 )
 (if (> char2 90)
   (setq char1 65
         char2 66
   )
 )
 (if (and (setq point1 (getpoint "\n Specify first point :"))
          (setq point2 (getpoint point1 "\n Specify Second point :"))
          (setq selectionset
                 (ssget "_F"
                        (list point1 point2)
                        '((0 . "LINE,*POLYLINE"))
                 )
          )

          (setq p (getpoint "\n Table insertion point :"))
     )
   (progn
     (vl-cmdf "_.pline" "_non" point1 "_non" point2 "")
     (setq height (if (zerop (cdr (assoc 40
                                         (setq st
                                                (entget
                                                  (tblobjname "STYLE" (getvar 'textstyle))
                                                )
                                         )
                                  )
                             )
                      )
                    (cdr (assoc 42 st))
                    (cdr (assoc 40 st))
                  )
     )
     (entmakex
       (list '(0 . "TEXT")
             (cons 40 (* height 3.))
             (cons 10
                   (polar point1
                          (setq ang (angle point2 point1))
                          (* height 1.
                   )
             )
             (cons 50 ang)
             (cons 1 (chr char1))
       )
     )
     (entmakex
       (list '(0 . "TEXT")
             (cons 40 (* height 3.))
             (cons 10
                   (polar point2
                          (setq ang (angle point1 point2))
                          (* height 3.5)
                   )
             )
             (cons 50 (angle point2 point1))
             (cons 1 (chr char2))
       )
     )
     (repeat (setq integer (sslength selectionset))
       (setq entities (cons (setq selectionsetname
                                   (ssname
                                     selectionset
                                     (setq integer (1- integer))
                                   )
                            )
                            entities
                      )
       )
       (if (not (member (setq singlelayer
                               (cdr (assoc 8 (entget selectionsetname)))
                        )
                        layers
                )
           )
         (setq layers (cons singlelayer layers))
       )
     )
     (setq i 0)
     (foreach layer layers
       (repeat (setq number (length entities))
         (if
           (eq
             (cdr
               (assoc 8
                      (entget (nth (setq number (1- number)) entities))
               )
             )
             layer
           )
            (setq lst (cons layer (setq i (1+ i))))
         )
       )
       (setq result (cons lst result))
       (setq i 0)
     )
     (setq space (if (> (vla-get-activespace
                          (setq acdoc (vla-get-activedocument
                                        (vlax-get-acad-object)
                                      )
                          )
                        )
                        0
                     )
                   (vla-get-modelspace acdoc)
                   (vla-get-paperspace acdoc)
                 )
     )
     (setq table (vla-addtable
                   space
                   (vlax-3d-point p)
                   (1+ (length result))
                   2
                   (* height 2.)
                   (* height 10.)
                 )
     )
     (vla-settext
       table
       0
       0
       (strcat "Section " (chr char1) " " (chr 45) " " (chr char2))
     )
     (setq r   0
           c   0
           inc -1
     )
     (repeat (length result)
       (vla-settext
         table
         (setq r (1+ r))
         c
         (car (nth (setq inc (1+ inc)) result))
       )
       (vla-setcellalignment table r c acMiddleCenter)
       (vla-settext
         table
         r
         (setq c (1+ c))
         (itoa (cdr (nth inc result)))
       )
       (vla-setcellalignment table r c acMiddleCenter)
       (setq c 0)
     )
   )
 )
 (princ)
)

[Michalis]

sir! i bow before you! THANK YOU A LOT

[Tharwat]

sir! i bow before you! THANK YOU A LOT

 

You're welcome Michalis .

 

Thanks for the nice words .

Enjoy it buddy .

 

Tharwat

[stevesfr]

Tharwat, nice programming, but results are tiny on insertion. How to revise to scale table larger?

thx

Steve

[Tharwat]

Tharwat, nice programming, but results are tiny on insertion. How to revise to scale table larger?

thx

Steve

 

Thank you Steve

 

Just increase the height of the text from the text style

[ReMark]

I wonder how much a company would have to pay for this type of custom lisp routine? I wonder? Hmmmmmmmmmmmmm.

[Tharwat]

I wonder how much a company would have to pay for this type of custom lisp routine? I wonder? Hmmmmmmmmmmmmm.

 

I wonder too !