Lisp for drawing polylines

[elfert]

I am trying to change the code myself according to the last message i wrote in this thread but i am getting a Error: no function definition: X+Y1

 

On this code:

 

(defun c:wzz ( / a d h i l n p q x y y1 d1)
   (setq h 20.0)
   (if (and
           (setq x  (getdist "\nWeld Length: "))
           (setq y1 (getreal "\nGuess a Weld length space: "))
           (setq p (getpoint "\n1st Point: "))
           (setq q (getpoint "\n2nd Point: " p))
           (setq p (trans p 1 0)
                 q (trans q 1 0)
                 a (angle p q)
                 d (distance p q)
                 i (/ pi 2.0)
                 d1 (x+y1)
                 n (fix (/ d d1))
           )
       )
       (if (< 0 n)
           (progn
               (setq y (- (/ n (- d x))(+ x y1)))
               (repeat n
                   (setq l (cons (cons 10 p) l)
                         l (cons (cons 10 (setq p (polar p a x))) l)
                         l (cons (cons 10 (setq p (polar p (- a i) h))) l)
                         l (cons (cons 10 (setq p (polar p a y))) l)
                         l (cons (cons 10 (setq p (polar p (+ a i) h))) l)
                   )
               )
               (entmake
                   (append
                       (list
                          '(000 . "LWPOLYLINE")
                          '(100 . "AcDbEntity")
                          '(100 . "AcDbPolyline")
                           (cons 90 (1+ (length l)))
                          '(70 . 0)
                       )
                       (reverse (cons (cons 10 (polar p a x)) l))
                   )
               )
           )
           (princ "\nDistance too small.")
       )
   )
   (princ)
)

Somebody got a clue...? thx

[elfert]

Okay i just found out what i was:

 

(defun c:wzz ( / a d h i l n p q x y y1 d1)
   (setq h 20.0)
   (if (and
           (setq x  (getdist "\nWeld Length: "))
           (setq y1 (getreal "\nGuess a Weld length space: "))
           (setq p (getpoint "\n1st Point: "))
           (setq q (getpoint "\n2nd Point: " p))
           (setq p (trans p 1 0)
                 q (trans q 1 0)
                 a (angle p q)
                 d (distance p q)
                 i (/ pi 2.0)
                 d1 (+ x y1)
                 n (fix (/ d d1))
           )
       )
       (if (< 0 n)
           (progn
               (setq y (- (/ n (- d x))(+ x y1)))
               (setq y2 (+ y y1))
               (repeat n
                   (setq l (cons (cons 10 p) l)
                         l (cons (cons 10 (setq p (polar p a x))) l)
                         l (cons (cons 10 (setq p (polar p (- a i) h))) l)
                         l (cons (cons 10 (setq p (polar p a y2))) l)
                         l (cons (cons 10 (setq p (polar p (+ a i) h))) l)
                   )
               )
               (entmake
                   (append
                       (list
                          '(000 . "LWPOLYLINE")
                          '(100 . "AcDbEntity")
                          '(100 . "AcDbPolyline")
                           (cons 90 (1+ (length l)))
                          '(70 . 0)
                       )
                       (reverse (cons (cons 10 (polar p a x)) l))
                   )
               )
           )
           (princ "\nDistance too small.")
       )
   )
   (princ)
)

 

But now it only drawing boxes i need it to draw a poly line like describe in message. #20 Please help anybody.

[elfert]

Hello Lee Mac!

 

I have tried to change the code a little bit so it fits what i write in the last message in the end of page 2:

 

(defun c:wzz ( / a d h i l n p q x y y1 y2 )
   (setq h 20.0)
   (if (and
           (setq x  (getreal "\nWeld Length: "))
           (setq y1 (getreal "\nGuess a Weld length space: "))
           (setq p (getpoint "\n1st Point: "))
           (setq q (getpoint "\n2nd Point: " p))
           (setq p (trans p 1 0)
                 q (trans q 1 0)
                 a (angle p q)
                 d (distance p q)
                 i (/ pi 2.0)
                 n (fix (/ d (+ x y1)))
           )
       )
       (if (< 0 n)
           (progn
               (setq y (- y1 (/ (- n 1)(- d (* x n)))))
               (setq y2 (+ y y1))
               (prin1 y)
               (prin1 y1)
               (prin1 y2)
               (prin1 n)
               (repeat n
                   (setq l (cons (cons 10 p) l)
                         l (cons (cons 10 (setq p (polar p a x))) l)
                         l (cons (cons 10 (setq p (polar p (- a i) h))) l)
                         l (cons (cons 10 (setq p (polar p a y2))) l)
                         l (cons (cons 10 (setq p (polar p (+ a i) h))) l)
                   )
               )
               (entmake
                   (append
                       (list
                          '(000 . "LWPOLYLINE")
                          '(100 . "AcDbEntity")
                          '(100 . "AcDbPolyline")
                           (cons 90 (1+ (length l)))
                          '(70 . 0)
                       )
                       (reverse (cons (cons 10 (polar p a x)) l))
                   )
               )
           )
           (princ "\nDistance too small.")
       )
   )
   (princ)
)

The values is for this example (see picture):

d=500, x=50 , y1 = 90 then the code should calculate the y to 10 and ad this to y1 so it i will calculate the y2 to 100.

 

But the code seams to make the y2 double, because it calculate the Y to the same as Y1 and ad this two together. But i am not sure about it. It could also be the way that the y is calculated.

 

 

I think so that i have put in a 'if' that checks if the Y1 and y are equal then the code should use y. But how and where do i put it in? I have put in some 'prin1' just to see the values when it runs i can always delete them when the code works.

 

Please Help Lee Mac or any body how have the knowledge....please.

[marko_ribar]

Thanks to Tweet from Lee's site, I've run on this topic and have something to offer in addition...

 

Here are more examples of entity generated linetypes...

 

https://www.theswamp.org/index.php?topic=46681

 

In addition to Lee's original version, I've modified it to fit my needs and implemented his GrSnap...

(You can add it and to Lee's version easily, just look into my example) :

 

;; Object Snap for grread: Snap Function  -  Lee Mac
;; Returns: [fun] A function requiring two arguments:
;; p - [lst] UCS Point to be snapped
;; o - [int] Object Snap bit code
;; The returned function returns either the snapped point (displaying an appropriate snap symbol)
;; or the supplied point if the snap failed for the given Object Snap bit code.

(defun LM:grsnap:snapfunction ( )
   (eval
       (list 'lambda '( p o / q )
           (list 'if '(zerop (logand 16384 o))
               (list 'if
                  '(setq q
                       (cdar
                           (vl-sort
                               (vl-remove-if 'null
                                   (mapcar
                                       (function
                                           (lambda ( a / b )
                                               (if (and (= (car a) (logand (car a) o)) (setq b (osnap p (cdr a))))
                                                   (list (distance p b) b (car a))
                                               )
                                           )
                                       )
                                      '(
                                           (0001 . "_end")
                                           (0002 . "_mid")
                                           (0004 . "_cen")
                                           (0008 . "_nod")
                                           (0016 . "_qua")
                                           (0032 . "_int")
                                           (0064 . "_ins")
                                           (0128 . "_per")
                                           (0256 . "_tan")
                                           (0512 . "_nea")
                                           (2048 . "_app")
                                           (8192 . "_par")
                                       )
                                   )
                               )
                              '(lambda ( a b ) (< (car a) (car b)))
                           )
                       )
                   )
                   (list 'LM:grsnap:displaysnap '(car q)
                       (list 'cdr
                           (list 'assoc '(cadr q)
                               (list 'quote
                                   (LM:grsnap:snapsymbols
                                       (atoi (cond ((getenv "AutoSnapSize")) ("5")))
                                   )
                               )
                           )
                       )
                       (LM:OLE->ACI
                           (if (= 1 (getvar 'cvport))
                               (atoi (cond ((getenv "Layout AutoSnap Color")) ("117761")))
                               (atoi (cond ((getenv  "Model AutoSnap Color")) ("104193")))
                           )
                       )
                   )
               )
           )
          '(cond ((car q)) (p))
       )
   )
)

;; Object Snap for grread: Display Snap  -  Lee Mac
;; pnt - [lst] UCS point at which to display the symbol
;; lst - [lst] grvecs vector list
;; col - [int] ACI colour for displayed symbol
;; Returns nil

(defun LM:grsnap:displaysnap ( pnt lst col / scl )
   (setq scl (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
         pnt (trans pnt 1 2)
   )
   (grvecs (cons col lst)
       (list
           (list scl 0.0 0.0 (car  pnt))
           (list 0.0 scl 0.0 (cadr pnt))
           (list 0.0 0.0 scl 0.0)
          '(0.0 0.0 0.0 1.0)
       )
   )
)

;; Object Snap for grread: Snap Symbols  -  Lee Mac
;; p - [int] Size of snap symbol in pixels
;; Returns: [lst] List of vector lists describing each Object Snap symbol

(defun LM:grsnap:snapsymbols ( p / -p -q -r a c i l q r )
   (setq -p (- p) q (1+  p)
         -q (- q) r (+ 2 p)
         -r (- r) i (/ pi 6.0)
          a 0.0
   )
   (repeat 12
       (setq l (cons (list (* r (cos a)) (* r (sin a))) l)
             a (- a i)
       )
   )
   (setq c (apply 'append (mapcar 'list (cons (last l) l) l)))
   (list
       (list 1
           (list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)
           (list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)
       )
       (list 2
           (list -r -q) (list 0  r) (list 0  r) (list r -q)
           (list -p -p) (list p -p) (list p -p) (list 0  p) (list 0  p) (list -p -p)
           (list -q -q) (list q -q) (list q -q) (list 0  q) (list 0  q) (list -q -q)
       )
       (cons 4 c)
       (vl-list* 8 (list -r -r) (list r r) (list r -r) (list -r r) c)
       (list 16
           (list p 0) (list 0 p) (list 0 p) (list -p 0) (list -p 0) (list 0 -p) (list 0 -p) (list p 0)
           (list q 0) (list 0 q) (list 0 q) (list -q 0) (list -q 0) (list 0 -q) (list 0 -q) (list q 0)
           (list r 0) (list 0 r) (list 0 r) (list -r 0) (list -r 0) (list 0 -r) (list 0 -r) (list r 0)
       )
       (list 32
           (list  r r) (list -r -r) (list  r q) (list -q -r) (list  q r) (list -r -q)
           (list -r r) (list  r -r) (list -q r) (list  r -q) (list -r q) (list  q -r)
       )
       (list 64
           '( 0  1) (list  0  p) (list  0  p) (list -p  p) (list -p  p) (list -p -1) (list -p -1) '( 0 -1)
           '( 0 -1) (list  0 -p) (list  0 -p) (list  p -p) (list  p -p) (list  p  1) (list  p  1) '( 0  1)
           '( 1  2) (list  1  q) (list  1  q) (list -q  q) (list -q  q) (list -q -2) (list -q -2) '(-1 -2)
           '(-1 -2) (list -1 -q) (list -1 -q) (list  q -q) (list  q -q) (list  q  2) (list  q  2) '( 1  2)
       )
       (list 128
           (list (1+ -p) 0) '(0 0) '(0 0) (list 0 (1+ -p))
           (list (1+ -p) 1) '(1 1) '(1 1) (list 1 (1+ -p))
           (list -p q) (list -p -p) (list -p -p) (list q -p)
           (list -q q) (list -q -q) (list -q -q) (list q -q)
       )
       (vl-list* 256 (list -r r)  (list r r) (list -r (1+ r)) (list r (1+ r)) c)
       (list 512
           (list -p -p) (list  p -p) (list -p  p) (list p p) (list -q -q) (list  q -q)
           (list  q -q) (list -q  q) (list -q  q) (list q q) (list  q  q) (list -q -q)
       )
       (list 2048
           (list   -p     -p) (list    p      p) (list   -p      p) (list    p     -p)
           (list (+ p 05) -p) (list (+ p 06) -p) (list (+ p 05) -q) (list (+ p 06) -q)
           (list (+ p 09) -p) (list (+ p 10) -p) (list (+ p 09) -q) (list (+ p 10) -q)
           (list (+ p 13) -p) (list (+ p 14) -p) (list (+ p 13) -q) (list (+ p 14) -q)
           (list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)
           (list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)
       )
       (list 8192 (list r 1) (list -r -q) (list r 0) (list -r -r) (list r q) (list -r -1) (list r r) (list -r 0))
   )
)

;; Object Snap for grread: Parse Point  -  Lee Mac
;; bpt - [lst] Basepoint for relative point input, e.g. @5,5
;; str - [str] String representing point input
;; Returns: [lst] Point represented by the given string, else nil

(defun LM:grsnap:parsepoint ( bpt str / str->lst lst )

   (defun str->lst ( str / pos )
       (if (setq pos (vl-string-position 44 str))
           (cons (substr str 1 pos) (str->lst (substr str (+ pos 2))))
           (list str)
       )
   )

   (if (wcmatch str "`@*")
       (setq str (substr str 2))
       (setq bpt '(0.0 0.0 0.0))
   )           

   (if
       (and
           (setq lst (mapcar 'distof (str->lst str)))
           (vl-every 'numberp lst)
           (< 1 (length lst) 4)
       )
       (mapcar '+ bpt lst)
   )
)

;; Object Snap for grread: Snap Mode  -  Lee Mac
;; str - [str] Object Snap modifier
;; Returns: [int] Object Snap bit code for the given modifier, else nil

(defun LM:grsnap:snapmode ( str )
   (vl-some
       (function
           (lambda ( x )
               (if (wcmatch (car x) (strcat (strcase str t) "*"))
                   (progn
                       (princ (cadr x)) (caddr x)
                   )
               )
           )
       )
      '(
           ("endpoint"      " of " 00001)
           ("midpoint"      " of " 00002)
           ("center"        " of " 00004)
           ("node"          " of " 00008)
           ("quadrant"      " of " 00016)
           ("intersection"  " of " 00032)
           ("insert"        " of " 00064)
           ("perpendicular" " to " 00128)
           ("tangent"       " to " 00256)
           ("nearest"       " to " 00512)
           ("appint"        " of " 02048)
           ("parallel"      " to " 08192)
           ("none"          ""     16384)
       )
   )
)

;; OLE -> ACI  -  Lee Mac
;; Args: c - [int] OLE Colour

(defun LM:OLE->ACI ( c )
   (apply 'LM:RGB->ACI (LM:OLE->RGB c))
)

;; OLE -> RGB  -  Lee Mac
;; Args: c - [int] OLE Colour

(defun LM:OLE->RGB ( c )
   (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(24 16 )
)

;; RGB -> ACI  -  Lee Mac
;; Args: r,g,b - [int] Red, Green, Blue values

(defun LM:RGB->ACI ( r g b / c o )
   (if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
       (progn
           (setq c (vl-catch-all-apply '(lambda ( ) (vla-setrgb o r g b) (vla-get-colorindex o))))
           (vlax-release-object o)
           (if (vl-catch-all-error-p c)
               (prompt (strcat "\nError: " (vl-catch-all-error-message c)))
               c
           )
       )
   )
)

;; Application Object  -  Lee Mac
;; Returns the VLA Application Object

(defun LM:acapp nil
   (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object)))
   (LM:acapp)
)

(vl-load-com) (princ)

;; Dynamic Zig-Zag  -  M.R.

(defun c:zz ( / unique osf osm a d gr g i l p q r x )
   (defun unique ( l )
       (if l (cons (car l) (vl-remove (car l) (unique (cdr l)))))
   )
   (defun collinear-p ( p1 p p2 )
     (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-
   )
   (setq osf (LM:grsnap:snapfunction) ;; Define optimised Object Snap function
         osm (getvar 'osmode)         ;; Retrieve active Object Snap modes
   )
   (setq x 10.0
         i (/ pi 4.0)
   )
   (if (setq p (getpoint "\nSpecify 1st Point: "))
       (progn
           (princ "\nSpecify 2nd Point [+/-] <Exit>: ")
           (while
               (progn
                   (setq gr (grread t 15 0)
                         g (car  gr)
                   )
                   (cond
                       (   (member g '(3 5))
                           (redraw)
                           (setq a (angle p (setq q (osf (cadr gr) osm)))
                                 d (distance p q)
                                 i (abs i)
                                 r p
                           )
                           (repeat (fix (/ d x))
                               (grdraw r (setq r (polar r (+ a i) (/ x (sqrt 2.0)))) 1 1)
                               (grdraw r (setq r (polar r (+ a (setq i (- i))) (/ x (sqrt 2.0)))) 1 1)
                           )
                           (if (not (equal 0.0 (rem d x) 1e-)
                               (grdraw r (polar r a (rem d x)) 1 1)
                           )
                           (= 5 g)
                       )
                       (   (= 2 g)
                           (cond
                               (   (member q '(43 61))
                                   (setq x (1+ x))
                               )
                               (   (member q '(45 95))
                                   (setq x (max (1- x) 1))
                               )
                           )
                       )
                   )
               )
           )
           (if (= 3 g)
               (progn
                   (setq i (abs i)
                         p (trans p 1 0)
                         q (trans q 1 0)
                         a (angle p q)
                   )
                   (repeat (fix (/ d x))
                       (setq l (cons (cons 10 p) l)
                             l (cons (cons 10 (setq p (polar p (+ a i) (/ x (sqrt 2.0))))) l)
                             l (cons (cons 10 (setq p (polar p (+ a (setq i (- i))) (/ x (sqrt 2.0))))) l)
                       )
                   )
                   (if (not (equal 0.0 (rem d x) 1e-)
                       (setq l (cons (cons 10 (polar p a (rem d x))) l))
                   )
                   (setq l (unique l))
                   (mapcar '(lambda ( a b c ) (if (collinear-p (cdr a) (cdr b) (cdr c)) (setq l (vl-remove b l)))) l (cdr l) (cddr l))
                   (entmake
                       (append
                           (list
                              '(000 . "LWPOLYLINE")
                              '(100 . "AcDbEntity")
                              '(100 . "AcDbPolyline")
                               (cons 90 (length l))
                              '(70 . 0)
                           )
                           (reverse l)
                       )
                   )
               )
           )
           (redraw)
       )
   )
   (princ)
)

 

But all credits go to Mr. Lee Mac - almost all is his work...

Hope you'll like it...

Regards, M.R.

[danglar]

.. some modifications of Lee and Marko codes:

Dynamic Tryangle ZigZag - DTZ.lsp

Dynamic ZigZag - DZG.lsp