Jump to content

Numbering along path

ziele_o2k

By ziele_o2k
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

ziele_o2k Community Regular

ziele_o2k

Posted
Posted

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.

2018-10-12_12-02-05.jpg.7880e7ddb6d376fcd68df8dc33df5bc8.jpg

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 Proficient

maratovich

Posted
Posted (edited)

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

Edited by maratovich
ronjonp Grand Master

ronjonp

Posted
Posted

Post the code you're using to generate that.

ziele_o2k Community Regular

ziele_o2k

Posted
  • Author
Posted

@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 Proficient

Emmanuel Delay

Posted
Posted (edited)

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 by Emmanuel Delay
ronjonp Grand Master

ronjonp

Posted
Posted (edited)

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

 

image.thumb.png.9652afad97479a4c82245f4f17a33ff7.png

Edited by ronjonp
  • Thanks 1
ziele_o2k Community Regular

ziele_o2k

Posted
  • Author
Posted (edited)

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:

 

num_path.gif

Edited by ziele_o2k
Lee Mac Grand Master

Lee Mac

Posted
Posted (edited)

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 by Lee Mac
  • Thanks 1
ziele_o2k Community Regular

ziele_o2k

Posted
  • Author
Posted

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

 

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