Jump to content

i need some help to adjust the current lsp

wiebe

By wiebe
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

wiebe Rookie

wiebe

Posted
Posted (edited)

Lable: (layer LG1, LG2, LG3)

Line, Layer, count

 

Current LSP

image.png.6586de5ee985ba4f4a437ad448749c8e.png

 

VoorstelLSP

image.png.84bc60846f0530464ef9624d3160c14f.png

 

 

TEST.dwg test.lsp

Edited by wiebe
devitg Experienced

devitg

Posted
Posted

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

image.png.9533cecdae38020af88e79d6d4f89f73.png

 

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  .

 

 

 

 

 

image.png.33fa720b889f214730d676c45ed2b297.png

BIGAL Grand Master

BIGAL

Posted
Posted (edited)

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 by BIGAL
devitg Experienced

devitg

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

 

image.png.180a6a8ee764f6c26c39f9473de35757.png

devitg Experienced

devitg

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

BIGAL

Posted
Posted

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

 

  • Like 1
devitg Experienced

devitg

Posted
Posted (edited)

@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 by devitg
add lisp
Tsuky Community Regular

Tsuky

Posted
Posted

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

 

Tsuky Community Regular

Tsuky

Posted
Posted
Quote

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

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

wiebe Rookie

wiebe

Posted
  • Author
Posted

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

image.png.a4f5b56485ca5ad992d238039cd3b783.png

Tsuky Community Regular

Tsuky

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

wiebe

Posted
  • Author
Posted

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.

 

image.thumb.png.f2f2c88bb6d9914b8ac44e3811d465ef.png

BIGAL Grand Master

BIGAL

Posted
Posted (edited)

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 by BIGAL
Tsuky Community Regular

Tsuky

Posted
Posted

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 Rookie

wiebe

Posted
  • Author
Posted

it works

Thanks for your cooperation
top 👍

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