Numbering along path

[ziele_o2k]

There is a lot of great numbering programs for cad (i.e. Incremental Numbering by Lee or Increment by Gile).

But I didn't found any numbering suite that will allow me to pick path (i.e. as lwpolyline) and number in accordance to this path.

Drawing below shows what I would like to achive.

I have only one question, how to recognize, on which side of my path is circle to number (top/bottom/left/right etc.)?

For sorting along curve (lwpolyline) I will use function vlax-curve-getClosestPointTo  and vlax-curve-getParamAtPoint. 

For now we can assume that path is made with line object.

 

[maratovich]

Is your number a block or a text in a circle?

Edited October 12, 2018 by maratovich

[ronjonp]

Post the code you're using to generate that.

[ziele_o2k]

@ronjonpthere is no code to generate this, I did this manually to show what I want to achieve

@maratovich in my drawing I have circles and text. Lets assume that I will work with circles.

Generally I need only idea how to sort "rows" in reference to selected path.

[Emmanuel Delay]

I would start like this. 

It doesn't tell you left, right... but it tells you the distance along the path.  Whomever drew the path, where the polyline started is distance 0. That's where the low number should be.

This can be reversed if needed.

 

This script just prints that distance (along with other data) on screen.  Your 1 real question was to get this, right?

 

I assume the circles are blocks with an attribute.

 

dwg in attachment

 

(defun c:test  (  / ss path i  pt1 pt2 dist blk)
 
  (princ "\nSelect blocks: ")
  (setq ss (ssget  '((0 . "INSERT") ) ))
  (setq path (entsel  "\nSelect Path: "))
 
  (setq i 0)
  (repeat (sslength ss)
 
    (princ "\nBlock number: ")
    (princ i)
    
    (setq blk (ssname ss i))
    (setq pt1 (cdr (assoc 10 (entget blk))) )
    (princ "\nInsert point of block: ")
    (princ pt1)
    (setq pt2 (vlax-curve-getClosestPointTo (car path) pt1))
    (princ "\nClosest point to on path: ")
    (princ pt2)
    
    (setq dist (vlax-curve-getDistAtPoint (car path) pt2) )
    (princ "\nClosest distance to path: ")
    (princ (distance pt1 pt2))

    (princ "\nDistance along path: ")
    (princ dist)
    
    (princ "\n")
    (setq i (+ i 1))
    
  )  
  (princ)
)

number_along_path.dwg

Edited October 12, 2018 by Emmanuel Delay

[ronjonp]

Not very pretty but this may give you a start. It currently inserts text.

 

(defun c:foo (/ a aa b c d e l ll n p pa)
  ;; RJP » 2018-10-12
  ;; Divides a polyline into segments then divides another distance at each of those
  ;; points while incrementing a number by 1. Polyline direction will dictate what
  ;; side the numbering starts on. Happy Friday!
  (cond
    ((and (setq e (car (entsel "\nPick your centerline: ")))
	  (= "LWPOLYLINE" (cdr (assoc 0 (entget e))))
;;;	  (setq a (getint "\nEnter number of segments to place on centerline: "))
;;;	  (setq b (getdist "\nEnter length for each segment: "))
;;;	  (setq c (getint "\nEnter quantity of numbers to place on each segment: "))
	  ;; Testing numbers
	  (setq	a 50
		b 25.
		c 5
	  )
     )
     (setq d (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
     (setq n 0)
     (repeat a
       (cond
	 ((setq p (vlax-curve-getpointatdist e n))
	  (setq aa (angle '(0 0 0) (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p))))
	  (setq n (+ n (/ d (1- a))))
	  (setq p (polar p (setq pa (+ aa (/ pi 2.))) (/ b 2.)))
	  (entmakex (list '(0 . "line") (cons 10 p) (cons 11 (polar p (+ pi pa) b)) '(8 . "line")))
	  (setq l nil)
	  (repeat c (setq l (cons p l)) (setq p (polar p (+ pi pa) (/ b (1- c)))))
	  (setq ll (cons (reverse l) ll))
	 )
       )
     )
     (setq n 0)
     (setq ll (reverse ll))
     (while (car ll)
       (foreach	p (mapcar 'car ll)
	 (entmakex (list '(0 . "TEXT")
			 '(100 . "AcDbEntity")
			 '(67 . 0)
			 '(8 . "text")
			 '(100 . "AcDbText")
			 (cons 10 p)
			 (cons 40 (/ (/ b (1- c)) 2.))
			 (cons 1 (itoa (setq n (1+ n))))
			 '(50 . 0.0)
			 '(41 . 1.0)
			 '(51 . 0.0)
			 '(71 . 0)
			 '(72 . 1)
			 (cons 11 p)
			 '(100 . "AcDbText")
			 '(73 . 2)
		   )
	 )
       )
       (setq ll (mapcar 'cdr ll))
     )
    )
  )
  (princ)
)

 

Edited October 12, 2018 by ronjonp

[ziele_o2k]

thanks @ronjonp for tip.

 

(defun c:foo 
    (   / 
        vector comp
        
        num_path ss i e c lst str
    )
    (defun vector (p1 p2)
        (mapcar '(lambda (%1 %2) (- %2 %1) ) p1 p2 )
    )
    (defun comp (opr1 item1 opr2 item2)
        (if (equal (item2 a) (item2 b) 0.1);replace 0.1 with fuzz
            (opr1 (item1 a) (item1 b))
            (opr2 (item2 a) (item2 b))
        )
    )
    (setq num_path (car (entsel "\nSelect path: ")))
    (princ "\nSelect circles")
    (setq ss (ssget (list (cons 0 "CIRCLE"))))
    ;get list of circles center points
    (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i)))
              c (cdr (assoc 10 (entget e)))
        )
        (if lst
            (setq lst (cons c lst))
            (setq lst (list c))
        )
    )
    ;extend list of coordinates to other necessary data
    (setq lst
        (mapcar
            '(lambda (% /  tmp_1 tmp_2 vec_pt vec_path tmp_3 )
                (setq tmp_1 (vlax-curve-getClosestPointTo num_path %))
                (setq tmp_2 (vlax-curve-getParamAtPoint num_path tmp_1))
                
                (setq vec_pt (vector % tmp_1))
                (setq vec_path (vlax-curve-getfirstderiv num_path tmp_2))
                (if (minusp  (sin (- (angle '(0 0 0) vec_pt) (angle '(0 0 0) vec_path))))
                    (setq tmp_3 (distance tmp_1 %))
                    (setq tmp_3 (* -1 (distance tmp_1 %)))
                )
                (list tmp_2 tmp_3 %)
            )
            lst
        )
    )
    (setq lst
        (mapcar 
            '(lambda (%) (nth % lst)) 
            (vl-sort-i 
                lst 
                '(lambda (a b) (comp < car > cadr))
            )
        )
    )
    (setq str 0)
    (foreach # lst
        (entmakex
            (list
                (cons 0 "TEXT")
                (cons 1 (itoa (setq str (1+ str))))
                (cons 10 (caddr #))
                (cons 40 10)
                (cons 50 0)
            )
        )
    )
    (princ)
)

(sorting from this post)

 

and example:

 

Edited October 12, 2018 by ziele_o2k

[Lee Mac]

On first glance, this -

(defun vector (p1 p2)
    (mapcar '(lambda (%1 %2) (- %2 %1) ) p1 p2 )
)

Could be written -

(defun vector (p1 p2)
    (mapcar '- p2 p1)
)

But at that point, you may as well just write the mapcar function inline.

 

Also this -

        (if lst
            (setq lst (cons c lst))
            (setq lst (list c))
        )

Can be replaced with -

(setq lst (cons c lst))

Since (cons c lst) == (list c) when lst is nil.

 

 

Edited October 12, 2018 by Lee Mac

[ziele_o2k]

@Lee Mac - rookie mistakes 

some improvements:

(defun c:foo 
    (   / 
        comp LM:SelectIf
        num_path ss i e c lst inc
    )
    (defun comp (opr1 item1 opr2 item2)
        (if (equal (item2 a) (item2 b) 0.1);replace 0.1 with fuzz
            (opr1 (item1 a) (item1 b))
            (opr2 (item2 a) (item2 b))
        )
    )
    (defun LM:SelectIf ( msg pred func keyw / sel ) (setq pred (eval pred))  
        (while
            (progn (setvar 'ERRNO 0) (if keyw (apply 'initget keyw)) (setq sel (func msg))
                (cond
                    (   (= 7 (getvar 'ERRNO))
                        (princ "\nMissed, Try again.")
                    )
                    (   (eq 'STR (type sel))
                        nil
                    )
                    (   (vl-consp sel)
                        (if (and pred (not (pred sel)))
                            (princ "\nInvalid Object Selected.")
                        )
                    )
                )
            )
        )
        sel
    )
    (if (and
            (setq num_path 
                (car
                    (LM:SelectIf
                        "\nSelect path: "
                        (lambda ( % )
                            (wcmatch (cdr (assoc 0 (entget (car %)))) "LINE,LWPOLYLINE,CIRCLE,SPLINE")
                        )
                        entsel nil
                    )
                )
            )
            (princ "\nSelect circles to number: ")
            (setq ss (ssget (list (cons 0 "CIRCLE"))))
        )
        (progn
            ;get list of circles center points
            (repeat (setq i (sslength ss))
                (setq e (ssname ss (setq i (1- i)))
                      c (trans (cdr (assoc 10 (entget e))) e 0)
                )
                (setq lst (cons c lst))
            )
            ;extend list of coordinates to other necessary data
            (setq lst
                (mapcar
                    '(lambda (% /  tmp_1 tmp_2 vec_pt vec_path tmp_3 )
                        (setq tmp_1 (vlax-curve-getClosestPointTo num_path %))
                        (setq tmp_2 (vlax-curve-getParamAtPoint num_path tmp_1))
                        (setq vec_pt (mapcar '- % tmp_1))
                        (setq vec_path (vlax-curve-getfirstderiv num_path tmp_2))
                        (if (minusp  (sin (- (angle '(0 0 0) vec_pt) (angle '(0 0 0) vec_path))))
                            (setq tmp_3 (distance tmp_1 %))
                            (setq tmp_3 (* -1 (distance tmp_1 %)))
                        )
                        (list tmp_2 tmp_3 %)
                    )
                    lst
                )
            )
            ;sort list
            (setq lst
                (mapcar 
                    '(lambda (%) (nth % lst)) 
                    (vl-sort-i 
                        lst 
                        '(lambda (a b) (comp < car > cadr))
                    )
                )
            )
            ;add numbering
            (setq inc 0)
            (foreach # lst
                (entmakex
                    (list
                        (cons 0 "TEXT")
                        (cons 1 (itoa (setq inc (1+ inc))))
                        (cons 10 (caddr #))
                        (cons 40 10)
                        (cons 50 0)
                    )
                )
            )
        )
    )
    (princ)
)