Quick label/counter

Quick label/counter

osayed643PD
Contributor Contributor
528 Views
4 Replies
Message 1 of 5

Quick label/counter

osayed643PD
Contributor
Contributor

Hi everyone, 

This is my first lisp script and I am trying to create the following :

1. pick polyline with mouse.

2. Pick polylines or blocks that intersect with the first polyline.

3. sort their order according to the direction that the first pline was drawn along.

4 number and remember last number to perform again.

 

 

I am getting tons of errors and have seen many sourced. sometimes i copy paste some scripts which reportedly worked fine don't work fine for me for some reason

here is my script:

 

 

(setq ss (ssget "F" (entsel "please pick pline")))
(setq count 0)
(princ length ss)
(foreach x ss
(setq count + count 1)
(setq mypt (gcen x))
(command text mypt 4 0 count)
(setq count count+1)
);foreach

0 Likes
529 Views
4 Replies
Replies (4)
Message 2 of 5

ВeekeeCZ
Consultant
Consultant

You really did not get too far...

 

(vl-load-com)

(defun c:IntersNumbering ( / LM:intersections p s l o z e)
  
  (or *in-n* (setq *in-n* 0))
  
  ;; Intersections  -  Lee Mac ;; Returns a list of all points of intersection between two objects ;; for the given intersection mode.
  ;; ob1,ob2 - [vla] VLA-Objects ;;     mod - [int] acextendoption enum of intersectwith method
  
  (defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
	     (vlax-method-applicable-p ob2 'intersectwith)
	     (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
	     )
      (repeat (/ (length lst) 3)
	(setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
	      lst (cdddr lst))))
    (reverse rtn))
  
  ; ======================================================================================================
  
  
  (if (and (setq p (car (entsel "\nSelect a polyline: ")))
	   (princ "Select intersecting polylines and blocks, ")
	   (setq s (ssget '((0 . "LWPOLYLINE,LINE,INSERT"))))
	   (or (ssdel p s) t)
	   (setq *in-n* (cond ((setq f (getint (strcat "\nStart with <" (itoa (1+ *in-n*)) ">: ")))
			       (1- f))
			      (*in-n*)))
	   
	   (setq o (vlax-ename->vla-object p))
	   (setq l '()
		 z (getvar 'textsize))
	   )
    (repeat (setq i (sslength s))
      (setq e (vlax-ename->vla-object (ssname s (setq i (1- i))))
	    l (append (LM:intersections o e acextendnone) l))))
  
  (and l
       (setq l (vl-sort l '(lambda (p1 p2) (< (vlax-curve-getdistatpoint p p1) (vlax-curve-getdistatpoint p p2)))))
       (foreach p l (entmake (list (cons 0 "TEXT") (cons 10 p) (cons 40 z) (cons 1 (itoa (setq *in-n* (1+ *in-n*))))))))
  
  (princ)
  )

 

0 Likes
Message 3 of 5

osayed643PD
Contributor
Contributor

I had a lot more written but I thought it was useless, I've been trying for a while

0 Likes
Message 4 of 5

osayed643PD
Contributor
Contributor

Thank you so much for your answer. There is a small issue when the main polyline intersects twice with an object, it leaves two numbers. Also how do I put the number in the geometric center of the pline or block? The code is too complex for me to understand, I only know the basics.

0 Likes
Message 5 of 5

ВeekeeCZ
Consultant
Consultant

I see that you have probably progressed to the next page in your learning since you were able to figure out that the programmer needs to have a dwg file available. Thumbs up!

 

So I was able to test the code below on your file and it works fine.

 

(vl-load-com)

(defun c:IntersNumbering ( / LM:intersections p s l o z e x g)
  
  (or *in-n* (setq *in-n* 0))
  
  ;; Intersections  -  Lee Mac ;; Returns a list of all points of intersection between two objects ;; for the given intersection mode.
  ;; ob1,ob2 - [vla] VLA-Objects ;;     mod - [int] acextendoption enum of intersectwith method
  
  (defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
	     (vlax-method-applicable-p ob2 'intersectwith)
	     (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
	     )
      (repeat (/ (length lst) 3)
	(setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
	      lst (cdddr lst))))
    (reverse rtn))
  
  ; ======================================================================================================
  
  
  (if (and (setq p (car (entsel "\nSelect a polyline: ")))
	   (princ "Select intersecting polylines and blocks, ")
	   (setq s (ssget '((0 . "LWPOLYLINE,LINE,INSERT"))))
	   (or (ssdel p s) t)
	   (setq *in-n* (cond ((setq f (getint (strcat "\nStart with <" (itoa (1+ *in-n*)) ">: ")))
			       (1- f))
			      (*in-n*)))
	   
	   (setq o (vlax-ename->vla-object p))
	   (setq z (getvar 'textsize))
	   )
    (repeat (setq i (sslength s))
      (setq e (vlax-ename->vla-object (ssname s (setq i (1- i)))))
      (if (and (setq x (LM:intersections o e acextendnone))
	       (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list e 'll 'ur))))
	       (setq g (mapcar '/ (apply 'mapcar (cons '+ (mapcar 'vlax-safearray->list (list ll ur)))) '(2 2)))
	       )
	(setq l (cons (list (car x) g) l)))))
  
  (and l
       (setq l (vl-sort l '(lambda (p1 p2) (< (vlax-curve-getdistatpoint p (car p1)) (vlax-curve-getdistatpoint p (car p2))))))
       (foreach p l (entmake (list (cons 0 "TEXT") (cons 10 (cadr p)) (cons 40 z) (cons 1 (itoa (setq *in-n* (1+ *in-n*))))))))
  
  (princ)
  )

 

0 Likes