Jump to content

Table for counting Plines length in layers


Mugna101

Recommended Posts

Ahoy mates!

I need help. i found this lisp online and im still too noob to read and understand how it goes properly. also i want to make a change in it but im not sure how..

Lisp:

(defun C:LAYLENGTH ( / *error* acdoc ss p i e a d l) (vl-load-com)
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark acdoc)

  (defun *error* (msg)
    (and
      msg
      (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*"))
      (princ (strcat "\nError: " msg))
    )
    (if
      (= 8 (logand (getvar 'undoctl) 8))
      (vla-endundomark acdoc)
    )
    (princ)
    )
  
  (if
    (and
      (setq ss (ssget ":L" '((0 . "LINE,POLYLINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
      (setq p (getpoint "\nTable scale depend on annotation scale.\nSpecify table insert point: "))
      )
    (progn
      (repeat
        (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i)))
              a (cdr (assoc 8 (entget e)))
              d (vlax-curve-getdistatparam e (vlax-curve-getendparam e))
        )
        (if
          (setq o (assoc a l))
          (setq l (subst (list a (+ (cadr o) d)) o l))
          (setq l (cons (list a d) l))
        )
      )
      (setq l (vl-sort l '(lambda (a b) (< (car a) (car b)))))
      (insert_table l p)
      )
    )
  (*error* nil)
  (princ)
  )

(defun insert_table (lst pct / tab row col ht i n space)
  (setq space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
        ht  (/ 2.5 (cond ((getvar 'cannoscalevalue)) (1.0)))
        pct (trans pct 1 0)
        n   (trans '(1 0 0) 1 0 T)
        tab (setq tab (vla-addtable space (vlax-3d-point pct) (+ 2 (length lst)) (length (car lst)) (* 2.5 ht) ht))
        )
  (vlax-put tab 'direction n)
  
  (mapcar
    (function
      (lambda (rowType)
        (vla-SetTextStyle  tab rowType (getvar 'textstyle))
        (vla-SetTextHeight tab rowType ht)
      )
    )
   '(2 4 1)
  )
  
  (vla-put-HorzCellMargin tab (* 0.14 ht))
  (vla-put-VertCellMargin tab (* 0.14 ht))

  (setq lst (cons (mapcar '(lambda (a) (strcat "Col" (itoa (1+ (vl-position a (car lst)))))) (car lst)) lst))

  (setq i 0)
  (foreach col (apply 'mapcar (cons 'list lst))
    (vla-SetColumnWidth tab i
      (apply
        'max
        (mapcar
          '(lambda (x)
             ((lambda (txb) (+ (abs (- (caadr txb) (caar txb))) (* 2.0 ht)))
              (textbox (list (cons 1 (vl-princ-to-string x)) (cons 7 (getvar 'textstyle)) (cons 40 ht)))
              )
             )
          col
          )
        )
      )
    (setq i (1+ i))
    )
  
  (setq lst (cons '("TITLE") lst))
  
  (setq row 0)
  (foreach r lst
    (setq col 0)
    (vla-SetRowHeight tab row (* 1.5 ht))
    (foreach c r
      (vla-SetText tab row col (if (numberp c) (rtos c) (vl-princ-to-string c)))
      (setq col (1+ col))
      )
    (setq row (1+ row))
    )
  )

This lisp wants me to select what i want it to count. which is nice and all and workable.. and then places a table where i choose in which it shows me the combined length of what i picked by layers

but Id rather have it automatically call out on specific list of layers in which to count ONLY its Lines, Plines, 2D Plines and 3D Plines  LENGTH combined seperated by layers.

 

is it possible?

example name of a layer is MUG_6602

i have atleast 8 layers which isnt always active but always appear in the dwg and never frozen or hidden.

I'd also rather it to show that if there are no Plines so it would return a 0 value in the table.

 

and also if i can add another line in this post and push it to the edge, id like the table to update automatically like when using the UPDATE command on fields

 Im asking too much.. i know it.. but it could really make me look good in my company :D

 

Thnx in advance to u all

Edited by Mugna101
Specified my needs more,,
Link to comment
Share on other sites

15 hours ago, BIGAL said:

Try this

 


(setq ss (ssget '((0 . "LINE,POLYLINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE")(8 . "0,red")))) ; add your layer names

 

SUPERB! tested it quickly and it worked like a charm!

Edited by Mugna101
My reply was in the quote.. got it out
Link to comment
Share on other sites

  • 1 year later...
On 1/12/2021 at 7:19 AM, BIGAL said:

Try this

 

(setq ss (ssget '((0 . "LINE,POLYLINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE")(8 . "0,red")))) ; add your layer names

 

hi @BIGALfrom the lisp may i know how to make a change the current unit mm or m with surfix. i already fieldformat "%lu6%ps[,m]%ct8[0.001]" . but i dont which part i have to put it. hope you can help me

Link to comment
Share on other sites

51 minutes ago, BIGAL said:

Not sure what you want post a dwg or image at least. Code above is by mhupp not me.

from the code above above result it show like table 1(attach image) . but if you dont mind . or if you can help. how to add on code to make it like table 2(attach image) or table 3(attach image)... thanks 

EXAMPLE.jpg

Link to comment
Share on other sites

Try these changes. I think 2nd one is more appropriate.

 

(vla-SetText tab row col (if (numberp c) (strcat (rtos c 2 2) "mm") (strcat (vl-princ-to-string c) "mm")))

(vla-SetText tab row col (if (numberp c) (strcat (rtos (/ c 1000.0) 2 3) "m") (strcat (vl-princ-to-string (/ c 1000.0)) "m")))

 

Link to comment
Share on other sites

On 11/26/2022 at 8:02 AM, BIGAL said:

Try these changes. I think 2nd one is more appropriate.

 

(vla-SetText tab row col (if (numberp c) (strcat (rtos c 2 2) "mm") (strcat (vl-princ-to-string c) "mm")))

(vla-SetText tab row col (if (numberp c) (strcat (rtos (/ c 1000.0) 2 3) "m") (strcat (vl-princ-to-string (/ c 1000.0)) "m")))

 

hi @BIGALi already try and i attached the code with picture the result from the code you giving. from laylenght rev1.lsp all text change mm and from laylenght rev2 no text on the table.

.

 

LAYLENGHT rev2.lsp LAYLENGHT rev1.lsp

LAYLENGHT rev1.jpg

LAYLENGHT rev2.jpg

Edited by fourxz
Link to comment
Share on other sites

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