Jump to content

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

Michalis

By Michalis
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Michalis Rookie

Michalis

Posted
Posted

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 belowCapture.jpg

  • Replies 22
  • Created
  • Last Reply

Top Posters In This Topic

  • Tharwat

    9

  • Michalis

    8

  • ReMark

    2

  • Lee Mac

    1

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

Tharwat
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

Tharwat
Tharwat

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 .

Posted Images

Tharwat Grand Master

Tharwat

Posted
Posted

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 Rookie

Michalis

Posted
  • Author
Posted

Capture(3).jpg

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,

 

Capture(4).jpg

Lee Mac Grand Master

Lee Mac

Posted
Posted

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 Rookie

Michalis

Posted
  • Author
Posted

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 :P now im at work and im thinking on how to make it from early morning!!!

Tharwat Grand Master

Tharwat

Posted
Posted

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 Grand Master

Tharwat

Posted
Posted

This one is much more better with a table . 8)

 

(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)
)

  • Like 1
  • Thanks 1
fixo Mentor

fixo

Posted
Posted (edited)

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 by fixo
Michalis Rookie

Michalis

Posted
  • Author
Posted

Im bigger Newbie than you think :P

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 . 8)

 

(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 Grand Master

Tharwat

Posted
Posted

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 Rookie

Michalis

Posted
  • Author
Posted

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 Grand Master

Tharwat

Posted
Posted
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 Rookie

Michalis

Posted
  • Author
Posted

Dear friends, lets make it harder :P

 

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 :P

Tharwat Grand Master

Tharwat

Posted
Posted
Dear friends, lets make it harder :P

 

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 :P

 

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

 

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)
)

  • Like 1
Michalis Rookie

Michalis

Posted
  • Author
Posted

sir! i bow before you! THANK YOU A LOT :):thumbsup:

Tharwat Grand Master

Tharwat

Posted
Posted
sir! i bow before you! THANK YOU A LOT :):thumbsup:

 

You're welcome Michalis .

 

Thanks for the nice words . :)

Enjoy it buddy .

 

Tharwat

stevesfr Rising Star

stevesfr

Posted
Posted

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

thx

Steve

Tharwat Grand Master

Tharwat

Posted
Posted
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 Grand Master

ReMark

Posted
Posted

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

Tharwat Grand Master

Tharwat

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

 

I wonder too ! :D

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.

×
 Share
Go to topic listing
×
×
  • Create New...