[Edit] Lisp draws multiple plines with different colors

[quyenpv]

Hello friends!
I want to write 1 lisp draw 1 time into 12 plines with different colors as the picture attached, but the lisp writing skill is not good, please help me to edit it. Thank you

 

 

(defun c:DrawPlineWithColor (/ startPoint direction length dist colorMap)
    (setq startPoint (getpoint "\nChọn điểm bắt đầu: "))
    (setq direction (angle startPoint (getpoint "\nChọn hướng: ")))
    (setq length (getdist "\nChọn độ dài: "))
    (setq dist (getdist "\nChọn khoảng cách giữa các đường: "))
    (setq colorMap '(256 257 258 259 260 261 262 263 264 265 266 267)) ; map color index to custom color
    (setq i 0)
    (repeat 12
        (command "_pline" 
                 (list (car startPoint) (cadr startPoint)) 
                 (list (+ (car startPoint) (* (cos direction) length)) 
                       (+ (cadr startPoint) (* (sin direction) length))) 
                 "")
        (setq lastCreated (entlast))
        (if lastCreated
            (entmod (append (entget lastCreated) (list (cons 62 (nth i colorMap))))
        ))
        (setq startPoint (list (+ (car startPoint) (* dist (sin direction)))
                               (- (cadr startPoint) (* dist (cos direction)))))
        (setq i (+ i 1))
    )
    (princ)
)

VeCapQuang.lsp

[Tsuky]

Hi,

If you want use the DXF code 62, you are limited to (0 at 256) 0=ByBlock 256=ByLayer

Else you must use DXF code 420 with RGB colors (it's a long interger) and is more complicated.

Exemple whith:

(setq colorMap '(11 41 71 101 131 161 191 221 32 62 92 122))

Your code work's well!

[Nikon]

(defun c:mln ( / _OffsetTo items ofd InsertAt evenp layersAndColors plines base)
(vl-load-com) 
(defun _OffsetTo (v e n flg / hfl v x y col v_)
  (setq hlf (if flg  (* v 0.5)  0 ) i 1 v_ v)
  (repeat n
    (setq y (car (vlax-invoke
                   e
                   'Offset
                   (if (and flg (null col))
                     (setq x hlf)
                     (progn (setq x (+ hlf v)
                                  v (+ v v_)
                                  i (1+ i)
                            )
                            x
                     )
                   )
                 )
            )
    )
    (setq col (cons (list x y) col))
  )
  col
)
(defun InsertAt (item ind lst);; Gile ;;
  (if (or (zerop ind) (null lst))
    (cons item lst)
    (cons (car lst) (InsertAt item (1- ind) (cdr lst)))
  )
) 
  (if (and
        (setq plines nil layersAndColors nil
              items  (getint "\nNumber of parallel lines: "))
       (< 1 items 13);<-- limit to 12
        (setq ofd (getdist "\nDistance between lines "))
        )
    (progn
        (repeat (Setq ln items)
          (setq layersAndColors (cons (list (Strcat "Layer" (itoa ln)) ln) layersAndColors)
                ln (1- ln)))
        (foreach lnm layersAndColors
          (if (not (tblsearch "Layer" (car lnm)))
                  (command "_layer" "_new" (car lnm) "_color" (cadr lnm) (car lnm) "")))
              
        (command "_Pline")
      (while (> (getvar "CMDACTIVE") 0)(command pause))
(setq base (vlax-ename->vla-object (entlast)))
 
 
  (setq evenp (zerop (rem items 2)))
    (foreach val (list ofd (- ofd))
                  (setq plines (cons (_OffsetTo val base (/ items 2) evenp) plines)))
      (setq plines (apply 'append
  (if evenp (progn
                  (vla-delete base) plines)
                 
                                      (InsertAt (list (list 0 base))
                                                (/ (length plines) 2)
                                                plines
                                      )
                               )
                  )
                )
      (mapcar 'vla-put-layer
              (mapcar 'cadr (vl-sort plines '(lambda (j k)(< (Car j)(car k)))))
              (mapcar 'car layersAndColors))
      );progn
    );if
  (princ)
  )

Lisp draws 2-12 polylines of different colors with a choice of the distance between them.
I don't know the author...

Calling with the mln command

Edited May 21, 2023 by Nikon

[quyenpv]

Thanks for your help. Because the job requires the above lisp and the specified color must follow that rule

[Tsuky]

Try with this list in your code:

 

(setq colorMap '(170 30 90 26 252 7 10 250 50 190 210 130))

But this selection is very personal (tastes and colors...)
Test this list in command line, to see if it is good for you.

(mapcar '(lambda (x) (acad_colordlg x nil)) '(170 30 90 26 252 7 10 250 50 190 210 130))

If this choice does not suit you, you can choose another color than the one offered.
The new list will be returned to you at the end of the loop, which you can copy and paste into your code.

Edited May 21, 2023 by Tsuky
choosing a new color list

[quyenpv]

A list will appear for selecting colors, but in the end the color is not applied to the drawn lines. I want the code to automatically draw according to the specified list of colors

(setq colorMap '(160 30 94 15 253 255 10 250 50 202 220 130)) ; map color index to fiber optic color rule

[quyenpv]

Command: ; error: syntax error

 

(defun c:mln ( / _OffsetTo items ofd InsertAt evenp layersAndColors plines base colorMap)
  (vl-load-com)

  (defun _OffsetTo (v e n flg / hlf v x y col v_)
    (setq hlf (if flg (* v 0.5) 0) i 1 v_ v)
    (repeat n
      (setq y (car (vlax-invoke e 'Offset (if (and flg (null col))
                                             (setq x hlf)
                                             (progn (setq x (+ hlf v)
                                                          v (+ v v_)
                                                          i (1+ i)))
                                             x))))
      (setq col (cons (list x y) col)))
    col)

  (defun InsertAt (item ind lst)
    (if (or (zerop ind) (null lst))
        (cons item lst)
        (cons (car lst) (InsertAt item (1- ind) (cdr lst)))))

  (setq colorMap '((1 . 160) (2 . 30) (3 . 94) (4 . 15) (5 . 253) (6 . 255) (7 . 10) (8 . 250) (9 . 50) (10 . 202) (11 . 220) (12 . 130)))

  (if (and (setq items (getint "\nSố đường thẳng song song: "))
           (< 1 items 13)
           (setq ofd (getdist "\nKhoảng cách giữa các dòng ")))
      (progn
        (repeat (setq ln items)
          (setq layersAndColors (cons (list (strcat "Layer" (itoa ln)) (cdr (assoc ln colorMap)))) layersAndColors)
          (setq ln (1- ln)))
        (foreach lnm layersAndColors
          (if (not (tblsearch "Layer" (car lnm)))
              (command "_layer" "_new" (car lnm) "_color" (cadr lnm) (car lnm) "")))

        (command "_pline")
        (while (> (getvar "CMDACTIVE") 0) (command pause))
        (setq base (vlax-ename->vla-object (entlast)))

        (setq evenp (zerop (rem items 2)))
        (setq plines (mapcar (lambda (val) (_OffsetTo val base (/ items 2) evenp))
                             (list ofd (- ofd))))
        (setq plines (apply 'append
                            (if evenp (progn
                                        (vla-delete base) plines)
                              (InsertAt (list (list 0 base))
                                        (/ (length plines) 2)
                                        plines))))
        (mapcar (lambda (pl) (vla-put-layer (cadr pl) (car pl)))
                (vl-sort layersAndColors '(lambda (j k) (< (car j) (car k))))))
    )

  (princ)
)

 

Edited May 21, 2023 by quyenpv

[Tsuky]

 

I can't check everything because I don't know exactly your purpose, but the fix seems to work.

See for yourself by comparing the versions the understanding of the errors.

(defun c:mln ( / _OffsetTo items ofd InsertAt evenp layersAndColors plines base colorMap)
  (vl-load-com)

  (defun _OffsetTo (v e n flg / hlf v x y col v_)
    (setq hlf (if flg (* v 0.5) 0) i 1 v_ v)
    (repeat n
      (setq y (car (vlax-invoke e 'Offset (if (and flg (null col))
                                             (setq x hlf)
                                             (setq x (+ hlf v)
                                                          v (+ v v_)
                                                          i (1+ i))
                                             ))))
      (setq col (cons (list x y) col)))
    col)

  (defun InsertAt (item ind lst)
    (if (or (zerop ind) (null lst))
        (cons item lst)
        (cons (car lst) (InsertAt item (1- ind) (cdr lst)))))

  (setq colorMap '((1 . 160) (2 . 30) (3 . 94) (4 . 15) (5 . 253) (6 . 255) (7 . 10) (8 . 250) (9 . 50) (10 . 202) (11 . 220) (12 . 130)))

  (if (and (setq items (getint "\nSố đường thẳng song song: "))
           (< 1 items 13)
           (setq ofd (getdist "\nKhoảng cách giữa các dòng ")))
      (progn
        (repeat (setq ln items)
          (setq layersAndColors (cons (list (strcat "Layer" (itoa ln)) (cdr (assoc ln colorMap))) layersAndColors))
          (setq ln (1- ln)))
        (foreach lnm layersAndColors
          (if (not (tblsearch "Layer" (car lnm)))
              (command "_layer" "_new" (car lnm) "_color" (cadr lnm) (car lnm) "")))

        (command "_pline")
        (while (> (getvar "CMDACTIVE") 0) (command pause))
        (setq base (vlax-ename->vla-object (entlast)))

        (setq evenp (zerop (rem items 2)))
        (setq plines (mapcar '(lambda (val) (_OffsetTo val base (/ items 2) evenp))
                             (list ofd (- ofd))))
        (setq plines (apply 'append
                            (if evenp (progn
                                        (vla-delete base) plines)
                              (InsertAt (list (list 0 base))
                                        (/ (length plines) 2)
                                        plines))))
        (mapcar '(lambda (pl to_lay) (vla-put-layer (cadr pl) (car to_lay)))
                plines
                (vl-sort layersAndColors '(lambda (j k) (< (car j) (car k)))))
    )
  )

  (princ)
)

 

[quyenpv]

@Nikon Thanks for your help
The first 6 colors are in the correct order but the order is reversed between 7 and 12, 8 with 11, 9 and 10. Please help me to fix it.

 

(defun c:mln ( / _OffsetTo items ofd InsertAt evenp layersAndColors plines base colorMap)
  (vl-load-com) 
  (defun _OffsetTo (v e n flg / hlf v x y col v_)
    (setq hlf (if flg  (* v 0.5)  0 ) i 1 v_ v)
    (repeat n
      (setq y (car (vlax-invoke
                      e
                      'Offset
                      (if (and flg (null col))
                        (setq x hlf)
                        (progn (setq x (+ hlf v)
                                     v (+ v v_)
                                     i (1+ i)
                               )
                               x
                        )
                      )
                  )
             )
      )
      (setq col (cons (list x y) col))
    )
    col
  )

  (defun InsertAt (item ind lst)
    (if (or (zerop ind) (null lst))
      (cons item lst)
      (cons (car lst) (InsertAt item (1- ind) (cdr lst)))
    )
  )

  (setq colorMap '(160 30 94 15 253 255 10 250 50 202 220 130))

  (if (and
         (setq plines nil layersAndColors nil
               items  (getint "\nNumber of parallel lines: "))
        (< 1 items 13)
        (setq ofd (getdist "\nDistance between lines "))
     )
    (progn
      (repeat (setq ln items)
        (setq layersAndColors (cons (list (strcat "Layer" (itoa ln)) (nth (1- ln) colorMap)) layersAndColors)
              ln (1- ln)
        )
      )
      (foreach lnm layersAndColors
        (if (not (tblsearch "Layer" (car lnm)))
            (command "_layer" "_new" (car lnm) "_color" (cadr lnm) (car lnm) "")
        )
      )
      (command "_Pline")
      (while (> (getvar "CMDACTIVE") 0)
        (command pause)
      )
      (setq base (vlax-ename->vla-object (entlast)))
      (setq evenp (zerop (rem items 2)))
      (foreach val (list ofd (- ofd))
        (setq plines (cons (_OffsetTo val base (/ items 2) evenp) plines))
      )
      (setq plines (apply 'append
                          (if evenp 
                            (progn
                              (vla-delete base) 
                              plines)
                            (InsertAt (list (list 0 base))
                                      (/ (length plines) 2)
                                      plines
                            )
                          )
                  )
      )
      (mapcar 'vla-put-layer
              (mapcar 'cadr plines)
              (mapcar 'car layersAndColors))

      (initget "Yes No")
    (if (= "Yes" (getkword "\nDo you want to number the lines? [Yes/No] <Yes>: "))
        (progn
            (setq numberPos (getpoint "\nSelect position for the numbers: "))
            (setq i 1)
            (repeat items
                (command "text" 
                         numberPos
                         2.5 0
                         (strcat "Line: " (itoa i))
                )
                (setq numberPos (list (+ (car numberPos) (* ofd (sin 0)))
                                      (- (cadr numberPos) (* ofd (cos 0)))))
                (setq i (+ i 1))
            )
        )
    )
    )
  )
  (princ)
)

 

MultiLine.lsp

[BIGAL]

My attempt, you can enter up to 13 offsets actaully around 20 is possible. Enter 0 or just erase for last entry check. Supports -ve as well.

; (defun c:mln ( / _OffsetTo items ofd InsertAt evenp layersAndColors plines base colorMap)
  (vl-load-com) 
 (defun c:mln ( /  )
(setq colorMap '(160 30 94 15 253 255 10 250 50 202 220 130))
(if (not AH:getvalsm)(load "Multi Getvals.lsp"))
(setq ans (AH:getvalsm (list "Enter New Offsets "
 "Off1 " 5 4 "10"
 "Off2 " 5 4 "20"
 "Off3 " 5 4 "30"
 "Off4 " 5 4 "40"
 "Off5 " 5 4 "50"
 "Off6 " 5 4 "60"
 "Off7 " 5 4 "70"
 "Off8 " 5 4 "80"
 "Off9 " 5 4 "90"
 "Off10 " 5 4 "100"
 "Off11 " 5 4 "110"
 "Off12 " 5 4 "120"
 "Off13 " 5 4 "130")
 )
)

(setq x 0)
(foreach val ans
  (if (or (= val "0")(= val ""))
    (setq ln x)
  )
  (setq x (1+ x))
)

(setq x 1 )
(setq layersAndColors '())
(repeat ln
 (setq layersAndColors (cons (list (strcat "Layer" (itoa x) ) (nth (1- x) colorMap)) layersAndColors))
 (setq x (1+ x))
)
(setq layersandcolors (reverse layersandcolors))

(foreach lnm layersAndColors
  (if (not (tblsearch "Layer" (car lnm)))
    (command "_layer" "_new" (car lnm) "_color" (cadr lnm) (car lnm) "")
  )
)

(command "_Pline")
(while (> (getvar "CMDACTIVE") 0)
   (command pause)
)

(setq obj (vlax-ename->vla-object (entlast)))
(vla-put-layer  obj (car (nth 0 layersAndColors)))
(setq start (vlax-curve-getstartpoint obj))

(initget "Yes No")
(setq YN (getkword "\nDo you want to number the lines? [Yes/No] <Yes>: "))
(if (= YN "Yes")
  (progn
    (setq numberPos (getpoint "\nSelect position for the numbers: "))
    (setq ptx (- (car numberpos)(car start)))
    (setq pty (- (cadr numberpos)(cadr start))) 
  )
)

(setvar 'textstyle "Standard")

(setq x 0)
(repeat ln 
  (vla-offset obj (atof (nth x ans)))
  (setq obj2 (vlax-ename->vla-object (entlast)))
  (vla-put-layer obj2 (car (nth x layersAndColors)))
  (setq start (vlax-curve-getstartpoint obj2))
  (if (= yn "Yes")
  (progn
    (setq numberpos (mapcar '+ start (list ptx pty 0.0)))
    (command "text" numberPos 2.5 0.0 (strcat "Line: " (itoa x)))
  )
  )
  (setq x (1+ x))
)

  (princ)
)
(c:mln)

You need to save the multi getvals.lsp to your support path directory for autoload.

Multi GETVALS.lsp

[quyenpv]

Thanks for Reply

APPLOAD Multi GETVALS.lsp successfully loaded.
Command: (10 20 30 40 50 60 70 80 90 100 110 120 130); error: bad argument type: fixnump: nil

[BIGAL]

So you want to pass a different color combo than the hard coded (setq colorMap '(160 30 94 15 253 255 10 250 50 202 220 130)).

 

I am working on  a multi getvals 2 col version so colors one side the other would be offsets, is that what you want ?

 

 

 

Edited May 22, 2023 by BIGAL