i need some help to adjust the current lsp

[wiebe]

Lable: (layer LG1, LG2, LG3)

Line, Layer, count

 

Current LSP

 

VoorstelLSP

 

 

TEST.dwg test.lsp

Edited March 25, 2023 by wiebe

[devitg]

@wiebe  as you set all numbers insertion points  [ 1 to 11]   at the  line ,

 

I did the same to the L1 L2 and so on. 

As to get  the L1 et all by ssget "F" dxf  10 and dxf 11 from each line , if not there will be a hard way to do such ssget to get the LN. 

Or show me how do you put such LN  at  each line.

Seem to be they where put at a equal distance from the each line dxf 10  .

 

 

 

 

 

[BIGAL]

It looks like a 2 step process label the lines by layer, they may be mixed up in drawn order L1, L4, L2, L3. 

 

Then get the lengths etc has been done many times, there is a post at moment floating around that does what you want the missing step which if I get time will be to put a linetype in the table, will find.

 

The other gotcha for this is if a line is drawn opposite way the label may be upside down and on right side not left side.

 

For me I would use a ssget "F" option selecting over all the lines near left side so label always go that side.

 

Answer Devitg questions why I have a hunt.

Edited March 27, 2023 by BIGAL

[devitg]

2 minutes ago, BIGAL said:

Answer Debitg questions why I have a hunt

@BIGAL

 

I found the this F ssget do not select the text 

 

(foreach ent ent@lay-lst
       (setq ent-10 (cdr (assoc 10 (entget ent))))
        (setq ent-11 (cdr (assoc 11 (entget ent))))
     
     (setq LN   (ssname ( ssget "F" (list ent-11 ent-10) '( ( 0 . "text")))0))
     (setq ln$ (cdr (assoc 1 (entget ln))))
     (setq ln$-list ( cons ln$ ln$-list))
)

Given ENT@lay-list hold all lines at the same layer but with differents LX 

Because the fence do not get any text 

 

[BIGAL]

Link for other post may be useful. https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-polyline-length-total-by-layer-in-table/td-p/11229892

 

Devitg understand but thought it would be better to label lines as part of the program. 

[devitg]

1 minute ago, BIGAL said:

Devitg understand but thought it would be better to label lines as part of the program. 

@BIGAL That is what the OP lisp do at the before LISP 

       (setq ent (nth 0 lst))
      (foreach ent lst
        (setq lenlst (cons (vla-get-length (vlax-ename->vla-object (cadr ent))) lenlst))
        (entmake (list (cons 0 "TEXT")
				(cons 10 (car ent))
			     (cons 40 250)
                       (cons 1 (itoa c))
                 )
        )
        (setq c (1- c))

      )

But it name each line from 1 to 11 , that is why I ask to OP to show how it named each line with Lx and Ly 

[BIGAL]

Need to add a layer check before writing text may be get a Selection list (( layer entity) ( layer entity) ( layer entity) .....

 

Sort on layer then label each line starting at a user number etc then step 2 is do table.

 

A sample 1st step then walk through the list of entities.

(prompt "Type F when asked for selection ")
(setq ss (ssget '((0 . "LINE"))))
(setq lst '())
(repeat (setq x (sslength ss))
(setq ent (entget (ssname ss (setq x (1- x)))))
(setq layer (cdr (assoc 8 ent)))
(setq entity (cdr (assoc -1 ent)))
(setq lst (cons (list layer entity) lst))
)
(setq lst (vl-sort lst '(lambda (J K) (< (car J)(car K)))))

 

[devitg]

@BIGAL It is what I have  Until I can not get the Ln  from each line at each layer 

;;*******************************************************************************************************
(DEFUN REMOVE-DUPS  (LISTE / RETLISTE) ;_ 01
  (FOREACH ITEM  LISTE
    (IF (NOT (MEMBER ITEM RETLISTE))
      (SETQ RETLISTE (CONS ITEM RETLISTE))
      )
    )
  (REVERSE RETLISTE)
  )
;;*******************************************************************************************************




(defun C:table-qty-lay-length (/ ss poly ent lst side lenlst pt objtable index c)
  (vl-load-com)
  (setq lst ())
  
  (if (setq SS (ssget '((0 . "line")(8 . "LG1,LG2,LG3,LG*"))))
    (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq ent (entget poly))
      (setq lst (cons (list (cdr (assoc 10 ent)) (cdr (assoc -1 ent))) lst)) ;build list with point and entity name
         

		)
        )
(setq ent (nth 0 lst))
  (setq lay-lst ())
(foreach ent lst
(setq lay  (cdr (assoc 8 (entget (cadr ent)))))
 (setq lay-lst (cons lay lay-lst)) 
)

(setq uniq-lay (vl-sort  (REMOVE-DUPS lay-lst) '<))  
(setq lay (nth 0 uniq-lay))
(setq dat-list ())  
(foreach lay uniq-lay

  (setq lay-ss (ssget "_X" (list (cons 0  "line") ( cons 8 lay))))
   (setq ent@lay-lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex lay-SS))))



  
  (setq ent (nth 0 ent@lay-lst))
   (foreach ent ent@lay-lst
       (setq ent-10 (cdr (assoc 10 (entget ent))))
        (setq ent-11 (cdr (assoc 11 (entget ent))))
     
     (setq LN   (ssname ( ssget "F" (list ent-11 ent-10) '( ( 0 . "text")))0))
     (setq ln$ (cdr (assoc 1 (entget ln))))
     (setq ln$-list ( cons ln$ ln$-list))
)

 

Edited March 26, 2023 by devitg
add lisp

[Tsuky]

Try with your lisp modified

(defun C:test ( / ss poly ent lst c n obj el tmp lenlst pt objtable index)
  (vl-load-com)
  (if (setq SS (ssget '((0 . "LINE")(8 . "LG1,LG2,LG3"))))
    (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq ent (entget poly))
      (setq lst (cons (list (cdr (assoc 10 ent)) (cdr (assoc -1 ent))) lst))
    )
  )
  (setq c 0 n 0)
  (foreach ent lst
    (setq
      obj (vlax-ename->vla-object (cadr ent))
      el (list (vla-get-length obj) (vla-get-layer obj))
    )
    (if (member el (mapcar 'car lenlst))
      (setq
        tmp (assoc (car (member el (mapcar 'car lenlst))) lenlst)
        lenlst (subst (cons el (cons (1+ (cadr tmp)) (cddr tmp))) tmp lenlst)
      )
      (setq lenlst (cons (cons el (cons (1+ c) (setq n (1+ n)))) lenlst))
    )
    (entmake
      (list
        (cons 0 "TEXT")
        (cons 10 (car ent))
        (cons 50 (angle (vlax-get obj 'startpoint) (vlax-get obj 'endpoint)))
        (cons 40 250)
        (cons 1 (strcat "L" (itoa (cddr (assoc el lenlst)))))
      )
    )
  )
  (setq
    pt (getpoint "\nSelect point insertion table: ")
    objtable (vla-AddTable (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3d-Point pt) (+ 2 (length lenlst)) 4 60 270)
    index 1
  )
  (vla-settext objtable 0 0 "HELLO")
  (vla-SetCellTextHeight objtable 0 0 200)
  (vla-SetCellAlignment objtable 0 0 acMiddleCenter)
  (vla-setcolumnwidth objtable 0 500)
  (vla-setcolumnwidth objtable 1 1000)
  (vla-setcolumnwidth objtable 2 1000)
  (vla-setcolumnwidth objtable 3 1000)

  (vla-settext objtable 1 0 "NR.")
  (vla-SetCellTextHeight objtable 1 0 200)
  (vla-SetCellAlignment objtable 1 0 acMiddleCenter)

  (vla-settext objtable 1 1 "Length")
  (vla-SetCellTextHeight objtable 1 1 200)
  (vla-SetCellAlignment objtable 1 1 acMiddleCenter)

  (vla-settext objtable 1 2 "Layer")
  (vla-SetCellTextHeight objtable 1 2 200)
  (vla-SetCellAlignment objtable 1 2 acMiddleCenter)

  (vla-settext objtable 1 3 "Count")
  (vla-SetCellTextHeight objtable 1 3 200)
  (vla-SetCellAlignment objtable 1 3 acMiddleCenter)

  (foreach elem (reverse lenlst)
    (vla-SetText objtable (setq index (1+ index)) 0 (strcat "L" (itoa (cddr elem))))
    (vla-SetCellTextHeight objtable index 0 200)
    (vla-SetCellAlignment objtable index 0 acMiddleCenter)

    (vla-SetText objtable index 1 (rtos (caar elem) 2 0))
    (vla-SetCellTextHeight objtable index 1 200)
    (vla-SetCellAlignment objtable index 1 acMiddleCenter)

    (vla-SetText objtable index 2 (cadar elem))
    (vla-SetCellTextHeight objtable index 2 200)
    (vla-SetCellAlignment objtable index 2 acMiddleCenter)

    (vla-SetText objtable index 3 (cadr elem))
    (vla-SetCellTextHeight objtable index 3 200)
    (vla-SetCellAlignment objtable index 3 acMiddleCenter)
  )
  (princ)
)

 

[BIGAL]

If more than 3 or less than (8 . "LG*")

[Tsuky]

Quote

If more than 3 or less than (8 . "LG*")

I prefer (8 . "LG#") # -> # (pound) : Matches any single numeric digit.

[wiebe]

Thanks for your cooperation (Tsuky/BIGAL)

1 more little question.

how can I have the length sizes rounded to 30 or 80 in the table

 

example:

line length 1850 becomes 1880

L1 4202 --> 4230

L2 4202 --> 4230

L3 1952 --> 1980

L4 1952 --> 1980

L5 1952 --> 1980

[Tsuky]

Quote

1 more little question.

how can I have the length sizes rounded to 30 or 80 in the table

 

example:

line length 1850 becomes 1880

L1 4202 --> 4230

L2 4202 --> 4230

L3 1952 --> 1980

L4 1952 --> 1980

L5 1952 --> 1980

Perhaps!

Add this function at my lisp

(defun round_number (xr n / )
	(* (fix (atof (rtos (* xr n) 2 0))) (/ 1.0 n))
)

And change the line

      el (list (vla-get-length obj) (vla-get-layer obj))

To this

      el (list (round_number (+ (vla-get-length obj) 30) 0.1) (vla-get-layer obj))

 

[wiebe]

Tsuky,

code does not give the desired result:

line length 2867 - 

rounded code 2900 -

wish outcome 2880

 

line length 3193 -

rounded code 3220 -

wish outcome 3230

etc.

 

[BIGAL]

The rounding will need a less than 30 for the last 2 digits then do similar for less than 100 need to think about it in a cond.

 

1224 divide 100 = 12.24 - fix = .24 less than 0.30 so it is changed to (0.30 + fix ) * 100 = 1230

Edited March 29, 2023 by BIGAL

[Tsuky]

Sorry, but your term:

Quote

how can I have the length sizes rounded to 30 or 80 in the table

Misled me, this term would have been more accurate:
 

Quote

how can i have the length sizes in the range at 30 or 80 in the table.

BIGAL is right in his reasoning.
Here is the corresponding code (to be checked anyway; tested summarily)

(defun range_number (x / )
  (cond
    ((and
      (<= (- x (* 100 (fix (* 0.01 (fix x))))) 30)
      (not (> (- x (* 100 (fix (* 0.01 (fix x))))) 80))
     )
      (+ (* 100 (fix (* 0.01 (fix x)))) 30)
    )
    (T
      (if (< (+ (* 100 (fix (* 0.01 (fix x)))) 80) x)
        (+ (* 100 (fix (* 0.01 (fix x)))) 130)
        (+ (* 100 (fix (* 0.01 (fix x)))) 80)
      )
    )
  )
)
(defun C:test ( / ss poly ent lst c n obj el tmp lenlst pt objtable index)
  (vl-load-com)
  (if (setq SS (ssget '((0 . "LINE")(8 . "LG#"))))
    (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq ent (entget poly))
      (setq lst (cons (list (cdr (assoc 10 ent)) (cdr (assoc -1 ent))) lst))
    )
  )
  (setq c 0 n 0)
  (foreach ent lst
    (setq
      obj (vlax-ename->vla-object (cadr ent))
      el (list (range_number (vla-get-length obj)) (vla-get-layer obj))
    )
    (if (member el (mapcar 'car lenlst))
      (setq
        tmp (assoc (car (member el (mapcar 'car lenlst))) lenlst)
        lenlst (subst (cons el (cons (1+ (cadr tmp)) (cddr tmp))) tmp lenlst)
      )
      (setq lenlst (cons (cons el (cons (1+ c) (setq n (1+ n)))) lenlst))
    )
    (entmake
      (list
        (cons 0 "TEXT")
        (cons 10 (car ent))
        (cons 50 (angle (vlax-get obj 'startpoint) (vlax-get obj 'endpoint)))
        (cons 40 250)
        (cons 1 (strcat "L" (itoa (cddr (assoc el lenlst)))))
      )
    )
  )
  (setq
    pt (getpoint "\nSelect point insertion table: ")
    objtable (vla-AddTable (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3d-Point pt) (+ 2 (length lenlst)) 4 60 270)
    index 1
  )
  (vla-settext objtable 0 0 "HELLO")
  (vla-SetCellTextHeight objtable 0 0 200)
  (vla-SetCellAlignment objtable 0 0 acMiddleCenter)
  (vla-setcolumnwidth objtable 0 500)
  (vla-setcolumnwidth objtable 1 1000)
  (vla-setcolumnwidth objtable 2 1000)
  (vla-setcolumnwidth objtable 3 1000)

  (vla-settext objtable 1 0 "NR.")
  (vla-SetCellTextHeight objtable 1 0 200)
  (vla-SetCellAlignment objtable 1 0 acMiddleCenter)

  (vla-settext objtable 1 1 "Length")
  (vla-SetCellTextHeight objtable 1 1 200)
  (vla-SetCellAlignment objtable 1 1 acMiddleCenter)

  (vla-settext objtable 1 2 "Layer")
  (vla-SetCellTextHeight objtable 1 2 200)
  (vla-SetCellAlignment objtable 1 2 acMiddleCenter)

  (vla-settext objtable 1 3 "Count")
  (vla-SetCellTextHeight objtable 1 3 200)
  (vla-SetCellAlignment objtable 1 3 acMiddleCenter)

  (foreach elem (reverse lenlst)
    (vla-SetText objtable (setq index (1+ index)) 0 (strcat "L" (itoa (cddr elem))))
    (vla-SetCellTextHeight objtable index 0 200)
    (vla-SetCellAlignment objtable index 0 acMiddleCenter)

    (vla-SetText objtable index 1 (rtos (caar elem) 2 0))
    (vla-SetCellTextHeight objtable index 1 200)
    (vla-SetCellAlignment objtable index 1 acMiddleCenter)

    (vla-SetText objtable index 2 (cadar elem))
    (vla-SetCellTextHeight objtable index 2 200)
    (vla-SetCellAlignment objtable index 2 acMiddleCenter)

    (vla-SetText objtable index 3 (cadr elem))
    (vla-SetCellTextHeight objtable index 3 200)
    (vla-SetCellAlignment objtable index 3 acMiddleCenter)
  )
  (princ)
)

 

[wiebe]

it works

Thanks for your cooperation
top