add vertex between leader and polyline

[pmadhwal7]

is their any way to add vertex between leader and polyline in one go at multiple location. 

Before:-

After

 

Edited January 4, 2023 by pmadhwal7

[Emmanuel Delay]

I made something

But with my test dwg it reacts a bit weird: it changes the location of the tip of the leader; because that leader is associated with the polyline.

Can you see if it works for you?

 

And anyone, feel free to step in.

 

Command PAVAL (for Polyline Add Vertex At Leader)

- select polyline

- select leaders

 

 

(vl-load-com)

;; LW Vertices  -  Lee Mac
;; Returns a list of lists in which each sublist describes
;; the position, starting width, ending width and bulge of the
;; vertex of a supplied LWPolyline
(defun LM:LWVertices ( e )
    (if (setq e (member (assoc 10 e) e))
        (cons
            (list
                (assoc 10 e)
                (assoc 40 e)
                (assoc 41 e)
                (assoc 42 e)
            )
            (LM:LWVertices (cdr e))
        )
    )
)

;; Tangent  -  Lee Mac
;; Args: x - real
(defun tan ( x )
    (if (not (equal 0.0 (cos x) 1e-10))
        (/ (sin x) (cos x))
    )
)

;;
;; Heavily inspired (I hope that's okay) by
;; http://www.lee-mac.com/addpolyvertex.html
;; I took the user input out of the function, they're now parameters of the function. 
;; Nor does it error check much.
;;
(defun addVertexToLWPolyline ( e p / a b e h l n p r v w x z)
    (if (and p e
            (setq p (vlax-curve-getclosestpointto e (trans p 1 0))
                  n (vlax-curve-getparamatpoint e p)
            )
        )
        (if (not (equal n (fix n) 1e-8))
            (progn
                (setq e (entget e)
                      h (reverse (member (assoc 39 e) (reverse e)))
                      v (assoc 90 h)
                      l (LM:LWVertices e)
                      z (assoc 210 e)
                )
                (repeat (fix n)
                    (setq a (cons (car l) a)
                          l (cdr l)
                    )
                )
                (setq x (car l)
                      r (- n (fix n))
                      w (cdr (assoc 40 x))
                      w (+ w (* r (- (cdr (assoc 41 x)) w)))
                      b (atan (cdr (assoc 42 x)))
                )
                ;;(LM:startundo (LM:acdoc))
                (entmod
                    (append
                        (subst (cons 90 (1+ (cdr v))) v h)
                        (apply 'append (reverse a))
                        (list
                            (assoc 10 x)
                            (assoc 40 x)
                            (cons  41 w)
                            (cons  42 (tan (* r b)))
                            (cons  10 (trans p 0 (cdr z)))
                            (cons  40 w)
                            (assoc 41 x)
                            (cons  42 (tan (* (- 1.0 r) b)))
                        )
                        (apply 'append (cdr l))
                        (list z)
                    )
                )
                ;;(LM:endundo (LM:acdoc))
            )
        )
    )
	e	;; return the modified polyline
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Intersections  -  Lee Mac
;; http://www.lee-mac.com/intersectionfunctions.html
;; 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
        ;; acextendnone 	      Do not extend either object
        ;; acextendthisentity 	Extend obj1 to meet obj2
        ;; acextendotherentity 	Extend obj2 to meet obj1
        ;; acextendboth 	      Extend both objects
(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)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; Polyline Add Vertex At Leader
(defun c:paval ( / pline leaders i pts pt  en ins)
	(setq pline (car (entsel "\nSelect polyline: ")))
	(princ "\nNow select the leaders: ")
	(setq leaders (ssget (list (cons 0 "LEADER"))))
	(setq i 0)
	(repeat (sslength leaders)
		(setq ins (LM:intersections (vlax-ename->vla-object pline) (vlax-ename->vla-object (ssname leaders i))  acextendnone))
		
		(setq en (addVertexToLWPolyline 
			pline  
			(nth 0 ins) ;; (setq pt (getpoint "\nGet Point: "))
		))
		(setq i (+ i 1))
	)
	
	(princ en)			
	(princ )			

)

 

polyline_add_vertex_at_leader.dwg

Edited January 4, 2023 by Emmanuel Delay

[pmadhwal7]

polyline vertex are shifted from leader head

 

 

 

[Emmanuel Delay]

Could you upload a DWG example?

[BIGAL]

The offset error can occur as ACAD and offers use some smarts to speed up zooms, did you do a regen ? Then it should align spot on. When plotting it is ok as well. There is some variables that you can set that alters the straight segments to visually look like curves, you can get circles to look like polygons if pushed low enough.

Edited January 6, 2023 by BIGAL

[pmadhwal7]

On 1/6/2023 at 1:48 PM, Emmanuel Delay said:

Could you upload a DWG example?

 

polyline_add_vertex_at_leader.dwg

[Emmanuel Delay]

Try this

 

(vl-load-com)

;; LW Vertices  -  Lee Mac
;; Returns a list of lists in which each sublist describes
;; the position, starting width, ending width and bulge of the
;; vertex of a supplied LWPolyline
(defun LM:LWVertices ( e )
    (if (setq e (member (assoc 10 e) e))
        (cons
            (list
                (assoc 10 e)
                (assoc 40 e)
                (assoc 41 e)
                (assoc 42 e)
            )
            (LM:LWVertices (cdr e))
        )
    )
)

;; Tangent  -  Lee Mac
;; Args: x - real
(defun tan ( x )
    (if (not (equal 0.0 (cos x) 1e-10))
        (/ (sin x) (cos x))
    )
)

;;
;; Heavily inspired (I hope that's okay) by
;; http://www.lee-mac.com/addpolyvertex.html
;; I took the user input out of the function, they're now parameters of the function. 
;; Nor does it error check much.
;;
(defun addVertexToLWPolyline ( e p on_pline / a b e h l n p r v w x z p_orig)
    (if (and p e
            (setq 
				p_orig p
				p (vlax-curve-getclosestpointto e (trans p 1 0))
				n (vlax-curve-getparamatpoint e p)
            )
        )
        (if (not (equal n (fix n) 1e-8))
            (progn
                (setq e (entget e)
                      h (reverse (member (assoc 39 e) (reverse e)))
                      v (assoc 90 h)
                      l (LM:LWVertices e)
                      z (assoc 210 e)
                )
                (repeat (fix n)
                    (setq a (cons (car l) a)
                          l (cdr l)
                    )
                )
                (setq x (car l)
                      r (- n (fix n))
                      w (cdr (assoc 40 x))
                      w (+ w (* r (- (cdr (assoc 41 x)) w)))
                      b (atan (cdr (assoc 42 x)))
                )
				
				;; if on_pline is nil, then we keep the opiginal point given by the user
				(if on_pline
					T
					(setq p p_orig)
				)
				
                ;;(LM:startundo (LM:acdoc))
                (entmod
                    (append
                        (subst (cons 90 (1+ (cdr v))) v h)
                        (apply 'append (reverse a))
                        (list
                            (assoc 10 x)
                            (assoc 40 x)
                            (cons  41 w)
                            (cons  42 (tan (* r b)))
                            (cons  10 (trans p 0 (cdr z)))
                            (cons  40 w)
                            (assoc 41 x)
                            (cons  42 (tan (* (- 1.0 r) b)))
                        )
                        (apply 'append (cdr l))
                        (list z)
                    )
                )
                ;;(LM:endundo (LM:acdoc))
            )
        )
    )
	e	;; return the modified polyline
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Polyline Add Vertex At Leader
(defun c:paval ( / pline leaders i pts pt  en ins)
	(setq pline (car (entsel "\nSelect polyline: ")))
	(princ "\nNow select the leaders: ")
	(setq leaders (ssget (list (cons 0 "LEADER"))))
	(setq i 0)
	(repeat (sslength leaders)
		;; pt is the first (assoc 10) of the leader
		(setq pt (cdr (assoc 10 (entget (ssname leaders i)))))
		(princ "\n")
		(princ pt)
		(setq en (addVertexToLWPolyline 
			pline 
			pt 
			nil
		))
		
		(setq i (+ i 1))
	)
	(princ)
)

 

[pmadhwal7]

17 hours ago, Emmanuel Delay said:

Try this

 

(vl-load-com)

;; LW Vertices  -  Lee Mac
;; Returns a list of lists in which each sublist describes
;; the position, starting width, ending width and bulge of the
;; vertex of a supplied LWPolyline
(defun LM:LWVertices ( e )
    (if (setq e (member (assoc 10 e) e))
        (cons
            (list
                (assoc 10 e)
                (assoc 40 e)
                (assoc 41 e)
                (assoc 42 e)
            )
            (LM:LWVertices (cdr e))
        )
    )
)

;; Tangent  -  Lee Mac
;; Args: x - real
(defun tan ( x )
    (if (not (equal 0.0 (cos x) 1e-10))
        (/ (sin x) (cos x))
    )
)

;;
;; Heavily inspired (I hope that's okay) by
;; http://www.lee-mac.com/addpolyvertex.html
;; I took the user input out of the function, they're now parameters of the function. 
;; Nor does it error check much.
;;
(defun addVertexToLWPolyline ( e p on_pline / a b e h l n p r v w x z p_orig)
    (if (and p e
            (setq 
				p_orig p
				p (vlax-curve-getclosestpointto e (trans p 1 0))
				n (vlax-curve-getparamatpoint e p)
            )
        )
        (if (not (equal n (fix n) 1e-8))
            (progn
                (setq e (entget e)
                      h (reverse (member (assoc 39 e) (reverse e)))
                      v (assoc 90 h)
                      l (LM:LWVertices e)
                      z (assoc 210 e)
                )
                (repeat (fix n)
                    (setq a (cons (car l) a)
                          l (cdr l)
                    )
                )
                (setq x (car l)
                      r (- n (fix n))
                      w (cdr (assoc 40 x))
                      w (+ w (* r (- (cdr (assoc 41 x)) w)))
                      b (atan (cdr (assoc 42 x)))
                )
				
				;; if on_pline is nil, then we keep the opiginal point given by the user
				(if on_pline
					T
					(setq p p_orig)
				)
				
                ;;(LM:startundo (LM:acdoc))
                (entmod
                    (append
                        (subst (cons 90 (1+ (cdr v))) v h)
                        (apply 'append (reverse a))
                        (list
                            (assoc 10 x)
                            (assoc 40 x)
                            (cons  41 w)
                            (cons  42 (tan (* r b)))
                            (cons  10 (trans p 0 (cdr z)))
                            (cons  40 w)
                            (assoc 41 x)
                            (cons  42 (tan (* (- 1.0 r) b)))
                        )
                        (apply 'append (cdr l))
                        (list z)
                    )
                )
                ;;(LM:endundo (LM:acdoc))
            )
        )
    )
	e	;; return the modified polyline
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Polyline Add Vertex At Leader
(defun c:paval ( / pline leaders i pts pt  en ins)
	(setq pline (car (entsel "\nSelect polyline: ")))
	(princ "\nNow select the leaders: ")
	(setq leaders (ssget (list (cons 0 "LEADER"))))
	(setq i 0)
	(repeat (sslength leaders)
		;; pt is the first (assoc 10) of the leader
		(setq pt (cdr (assoc 10 (entget (ssname leaders i)))))
		(princ "\n")
		(princ pt)
		(setq en (addVertexToLWPolyline 
			pline 
			pt 
			nil
		))
		
		(setq i (+ i 1))
	)
	(princ)
)

 

 

Great thanks working fine