help me numbering polyline and change thickness to thier number and write number above the middle

[ibrahelba]

i dont know how to start can anyone help me find lisp or begin lisp to auto numbering select multi-polyline and change thickness to thier number and write number above the middle 

[Steven P]

Just a work in progress, this might get you started to number each polyline (number is inserted to the left of the end point). Copy and pasted the entmake text, there might be better ways to do that, it is what was handy today

 

 

(defun c:numberpolylines ( / txthght sspolylines acount ssent txtpt )
  (defun createtext ( MyText TextPoint textheight / ) ;; a sub routine to create text.
    (entmake (list
      '(0 . "TEXT")
      '(100 . "AcDbEntity")
      '(8 . "0")
      '(100 . "AcDbText")
      (cons 10 TextPoint)
      (cons 40 textheight)
      (cons 1 MyText)
      '(50 . 0.0)
      '(41 . 1.0)
      '(51 . 0.0)
;;      (cons 7 font)
      '(71 . 0)
      '(72 . 0)
      '(11 0.0 0.0 0.0)
      '(210 0.0 0.0 1.0)
      '(100 . "AcDbText")
      '(73 . 0)
    ));end list, entmake
  ) ;;end sub routine


  (setq txthght 2.5) ;; text height - can calculate this later if needed to make it relative to polyline lengths and so on
  (setq sspolylines (ssget '((0 . "LWPOLYLINE")) )) ;get selection set, filter it to only LWPolyline types
  (setq acount 0) ;;just a counter
  (while (< acount (sslength sspolylines))  ;; do a loop for the length of the selection set (sslength)
    (setq ssent (ssname sspolylines acount ))  ;;get the nth entity details in the selection set
    (setq txtpt (cdr (assoc 10 (reverse (entget ssent)))) )  ;;get the end point of the polyline for text position
    (setq txtpt (mapcar '+ (list 5 (/ txthght 2) 0) txtpt )) ;; offset txtpt for text position by x:5, y: half text height, z:0
    (setq acount (+ acount 1)) ;;increase count by 1. Increased here to make the displayed text start at 1
    (createtext (rtos acount) txtpt txthght) ;; run subroutine to create text
  )

  (princ) ;; exit silently
)

 

Edited July 4, 2022 by Steven P

[Steven P]

And this version put the text in the middle of the polyline and makes the width the same as the counter.

 

(defun c:numberpolylines ( / txthght sspolylines acount ssent txtpt )
  (vl-load-com)

  ;;https://autocadtips1.com/2011/10/21/autolisp-mid-point-of-entire-polyline/
  (defun MidPoly ( ename / entl en oname param hLen MidPt )
    (setq entl (entget ename)
          en (cdr (assoc 0 entl))
    ) ;end setq
    (setq oname (vlax-ename->vla-object ename)
          param (vlax-curve-getEndParam oname)
          hlen (* (vlax-curve-getDistAtParam oname param) 0.5)
          MidPt (vlax-curve-getPointAtDist oname hLen)
    ) ;end setq
    (vlax-release-object oname)
    MidPt
  ) ;end defun

  (defun createtext ( MyText TextPoint textheight / ) ;; a sub routine to create text.
    (entmake (list
      '(0 . "TEXT")
      '(100 . "AcDbEntity")
      '(8 . "0")
      '(100 . "AcDbText")
      (cons 10 TextPoint)
      (cons 40 textheight)
      (cons 1 MyText)
      '(50 . 0.0)
      '(41 . 1.0)
      '(51 . 0.0)
;;      (cons 7 font)
      '(71 . 0)
      '(72 . 0)
      '(11 0.0 0.0 0.0)
      '(210 0.0 0.0 1.0)
      '(100 . "AcDbText")
      '(73 . 0)
    ));end list, entmake
  ) ;;end sub routine

  (setq txthght 2.5) ;; text height - can calculate this later if needed to make it relative to polyline lengths and so on
  (setq sspolylines (ssget '((0 . "LWPOLYLINE")) )) ;get selection set, filter it to only LWPolyline types
  (setq acount 0) ;;just a counter
  (while (< acount (sslength sspolylines))  ;; do a loop for the length of the selection set (sslength)
    (setq ssent (ssname sspolylines acount ))  ;;get the nth entity details in the selection set
    (setq TxtPt (MidPoly ssent)) ;;calls MidPoly routine and gets the point result as TxtPt
    (setq txtpt (mapcar '+ (list 0 (/ (+ acount txthght) 2) 0) txtpt )) ;; offset txtpt for text position by x:0, y: half text height + line width, z:0
    (setq acount (+ acount 1)) ;;increase count by 1. Increased here to make the displayed text start at 1
    (command "pedit" ssent "w" acount "") ;;adjusts line width to the count
    (createtext (rtos acount) txtpt txthght) ;; run subroutine to create text
  )
  (princ) ;; exit silently
)

 

 

So over to you now, how you want to use this or amend to suit what you want

[ibrahelba]

thank you very much you are my hero

[ibrahelba]

 

I made some changes to make this routine begine with input number as i am beginner in this lisp programming i dont know why the count start from the input number and refuse to numbering the previous polylines

the lisp  

(defun c:numberpolylines ( / txthght sspolylines acount ssent txtpt )
  (vl-load-com)

  ;;https://autocadtips1.com/2011/10/21/autolisp-mid-point-of-entire-polyline/
  (defun MidPoly ( ename / entl en oname param hLen MidPt )
    (setq entl (entget ename)
          en (cdr (assoc 0 entl))
    ) ;end setq
    (setq oname (vlax-ename->vla-object ename)
          param (vlax-curve-getEndParam oname)
          hlen (* (vlax-curve-getDistAtParam oname param) 0.5)
          MidPt (vlax-curve-getPointAtDist oname hLen)
    ) ;end setq
    (vlax-release-object oname)
    MidPt
  ) ;end defun

  (defun createtext ( MyText TextPoint textheight / ) ;; a sub routine to create text.
    (entmake (list
      '(0 . "TEXT")
      '(100 . "AcDbEntity")
      '(8 . "0")
      '(100 . "AcDbText")
      (cons 10 TextPoint)
      (cons 40 textheight)
      (cons 1 MyText)
      '(50 . 0.0)
      '(41 . 1.0)
      '(51 . 0.0)
;;      (cons 7 font)
      '(71 . 0)
      '(72 . 0)
      '(11 0.0 0.0 0.0)
      '(210 0.0 0.0 1.0)
      '(100 . "AcDbText")
      '(73 . 0)
    ));end list, entmake
  ) ;;end sub routine

  (setq txthght 250) ;; text height - can calculate this later if needed to make it relative to polyline lengths and so on
  (setq acount  (cond
                                             ((getint (strcat "\nEnter number"
                                        (if acount
                                              (strcat " <"
                                                      (itoa acount)
                                                      ">: ")
                                              ": ")
                                        )))
                       (acount))
            ) ;;just a counter
(setq sspolylines (ssget '((0 . "LWPOLYLINE")) )) ;get selection set, filter it to only LWPolyline types
  (while   ;; do a loop for the length of the selection set (sslength)
    (setq ssent (ssname sspolylines acount ))  ;;get the nth entity details in the selection set
    (setq TxtPt (MidPoly ssent)) ;;calls MidPoly routine and gets the point result as TxtPt
    (setq txtpt (mapcar '+ (list 0 (/ (+ acount txthght) 2) 0) txtpt )) ;; offset txtpt for text position by x:0, y: half text height + line width, z:0
    (setq acount (+ acount 1)) ;;increase count by 1. Increased here to make the displayed text start at 1
    (command "chprop" ssent "" "thickness" acount "") ;;adjusts line width to the count
    (createtext (rtos acount) txtpt txthght) ;; run subroutine to create text
  )
  (princ) ;; exit silently
)

[Steven P]

JHust to make it a bit easier to read if you put any code in between the code tags ( the <> button at the top of your text entry box), it gives it the grey background and makes it a bit easire to read

 

Answering your question, acount is a counter and does more than label the lines. If you look through the code you will see it appearing a few times. For example it is used to indicate which line to label as it loops through the routine (the while loop), if you start acount at a larger number then the first few will be ignored... it is just how that loop works. If acount is larger than the number of lines nothing will happen

 

I think you are wanting the user to specify their own numbering and in this case it might be better to use a new variable, each loop increment that as well as acount

Maybe something like this

 

(setq labelcounter "Enter the initial value <1>") ;;makes it simpler if you are not worried about acount
(if (= labelcounter nil) ;;enter was pressed but no number
  (set labelcounter 1) ;;set it to 1, a default
)

 

and then change this lien to the other 2:

 

  (createtext (rtos acount) txtpt txthght) ;; run subroutine to create text

change to:

  (setq labelcounter (+ 1 labelcounter))
  (createtext (rtos labelcounter) txtpt txthght) ;; run subroutine to create text

 

[ibrahelba]

thank you very much for helping me put first step in this subject 

I am trying to find some routine which help me to get what I want if the numbering was closed and i want to continue where it was stopped i find this routine and put some changes to make the polyline thickness as counter but it put the count in exact midpoint of polyline 

I wandering can i use your mid point in this rountine 

(defun c:LMBS(/ sel e sum verts ptList p_)

;;	Label Me Buddy			;;
;;	pBe Feb 2018			;;
;;--------------------------------------;;
;;	Kent Cooper sum|verts		;;
;;--------------------------------------;;

      (defun MidPoly ( ename / entl en oname param hLen MidPt )
    (setq entl (entget ename)
          en (cdr (assoc 0 entl))
    ) ;end setq
    (setq oname (vlax-ename->vla-object ename)
          param (vlax-curve-getEndParam oname)
          hlen (* (vlax-curve-getDistAtParam oname param) 0.5)
          MidPt (vlax-curve-getPointAtDist oname hLen)
    ) ;end setq
    (vlax-release-object oname)
    MidPt
 ) ;end defun
         (setq inc  (cond
                       ((getint (strcat "\nEnter number"
                                        (if inc
                                              (strcat " <"
                                                      (itoa inc)
                                                      ">: ")
                                              ": ")
                                        )))
                       (inc))
            )

      (if
            (setq ss (ssget '((0 . "LWPOLYLINE"))))

                 (repeat (sslength ss)
                       (setq e     (ssname ss 0)
                             sum   '(0 0)
                             verts (cdr (assoc 90 (setq ent (entget e)))))
                       (setq ptList (MidPoly ss))
                       (setq ptList
                                  (mapcar '+ (list 0 (/ (txthght) 2) 0) ptList ))
                       (foreach x ptList (setq sum (mapcar '+ x sum)))
                       (setq p_ (mapcar '/ sum (list verts verts)))
                       (entmakex
                             (list
                                   (cons 0 "TEXT")
                                   (cons 10 p_)
                                   (cons 11 p_)
                                   (cons 8 (cdr (assoc 8 ent)))
                                   '(40 . 200)
                                   '(72 . 4)
                                   '(73 . 3)
                                   (cons 1 (itoa inc))
                                   )
                             )
                        (command "chprop" ss "" "thickness" inc "")  
                       (setq inc (1+ inc))
                       (ssdel e ss)
                       )
                 )
      (princ)
      )