Jump to content

[Edit] Lisp draws multiple plines with different colors

quyenpv

By quyenpv
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

quyenpv Apprentice

quyenpv

Posted
Posted

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

 

image.thumb.png.b6da33da3f983f1a6d0ea1cb5c1d08a3.png

  

(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

Link to comment
Share on other sites
Tsuky Community Regular

Tsuky

Posted
Posted

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!

  • Like 1
Link to comment
Share on other sites
Nikon Community Regular

Nikon

Posted
Posted (edited) 
(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

2023-05-21_10-54-07.png

Edited by Nikon
  • Like 1
Link to comment
Share on other sites
Tsuky Community Regular

Tsuky

Posted
Posted (edited)

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 by Tsuky
choosing a new color list
Link to comment
Share on other sites
quyenpv Apprentice

quyenpv

Posted
  • Author
Posted

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

Link to comment
Share on other sites
quyenpv Apprentice

quyenpv

Posted
  • Author
Posted (edited)

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 by quyenpv
Link to comment
Share on other sites
Tsuky Community Regular

Tsuky

Posted
Posted

 

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

 

Link to comment
Share on other sites
quyenpv Apprentice

quyenpv

Posted
  • Author
Posted

@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

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

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.

image.png.fb48a7da8074fbb2726511afa5eb35a0.png 

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

Link to comment
Share on other sites
quyenpv Apprentice

quyenpv

Posted
  • Author
Posted

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

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

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 ?

 

image.png.14de4d2c7ccc170d01e9ef3bd2d7150f.png

 

 

Edited by BIGAL
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...