TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: lessbutmore on November 14, 2019, 08:56:11 PM

Title: Modifying a lisp adding a point to object
Post by: lessbutmore on November 14, 2019, 08:56:11 PM
Hi.

I'd like to modify my lisp. (Thanks Lee mac!)

It adds a point to object.

but It is uncomfortable to be able to add a point just ONE TIME.

Is it possible to modify for adding multiple points continually?



Code: [Select]

;;----------------=={ Add LWPolyline Vertex }==---------------;;
;;                                                            ;;
;;  Adds a new vertex to an LWPolyline at a point specified   ;;
;;  by the user; compatible with LWPolylines at any           ;;
;;  orientation, with varying width and arc segments.         ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2012 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Version 1.0    -    17-12-2012                            ;;
;;                                                            ;;
;;  First release.                                            ;;
;;------------------------------------------------------------;;


(defun c:QQ ( / a b e h l n p r w x z )
    (while
        (progn (setq p (getpoint "\nPick Point for New Vertex: "))
            (cond
                (   (null p) nil)
                (   (null (setq e (nentselp p)))
                    (princ "\nPoint does not lie on an LWPolyline.")
                )
                (   (= 4 (length e))
                    (princ "\nObject is Nested.")
                )
                (   (/= "LWPOLYLINE" (cdr (assoc 0 (entget (setq e (car e))))))
                    (princ "\nObject is not an LWPolyline.")
                )
            )
        )
    )
    (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)))
                      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)))
                )
                (entmod
                    (append h
                        (apply 'append (reverse a))
                        (list
                            (assoc 10 x)
                            (assoc 40 x)
                            (cons  41 w)
                            (cons  42 (tan (* r b)))
                        )
                        (list
                            (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)
                    )
                )
            )
        )
    )
    (princ)
)


;; Tangent  -  Lee Mac
;; Args: x - real


(defun tan ( x )
    (if (not (equal 0.0 (cos x) 1e-10))
        (/ (sin x) (cos x))
    )
)


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


(vl-load-com) (princ)


;;------------------------------------------------------------;;
;;                        End of File                         ;;
;;------------------------------------------------------------;;




Title: Re: Modifying a lisp adding a point to object
Post by: BIGAL on November 16, 2019, 12:36:58 AM
This is posted somewhere else just moved the while to start - end removed progn. Cadtutor.net , Autodesk/forum ?
Title: Re: Modifying a lisp adding a point to object
Post by: ahsattarian on December 01, 2020, 12:56:45 AM
This Helps U   :




Code - Auto/Visual Lisp: [Select]
  1. (defun c:pa ()
  2.   (defun sub1 ()
  3.     (setvar "osmode" 0)
  4.     (initget (+ 1 16))
  5.     (setq po (getpoint "\n Point : ")) ;|  #getpoint  |;
  6.     (setq pt1 (vlax-curve-getclosestpointto s po)) ;|  not necessary  |;
  7.     (grdraw po pt1 8 1)
  8.   )
  9.   (initget "On Free")
  10.   (setq pa3-var1 (getkword "\n Method [On/Free] : "))
  11.   (setq s (car (entsel "\n Select Polyline : ")))
  12.   (sub1)
  13.   (while pt1
  14.     (command "break" s pt1 pt1)
  15.     (command "pedit" s "j" (entlast) "" "")
  16.     (cond
  17.       ((= pa3-var1 "Free")
  18.        (setvar "autosnap" 39)
  19.        (setvar "orthomode" 0)
  20.        (command "stretch" "c" pt1 pt1 "" pt1 pause) ;|  #stretch  |;
  21.        (setq pt2 (getvar "lastpoint"))
  22.       )
  23.     )
  24.     (command "pselect" s "")
  25.     (sub1)
  26.   )
  27. )