hi
somebody can write me lisp code here for draw for example triple parallel line ? each line will be own layer and color..
thank you
Solved! Go to Solution.
Solved by pbejse. Go to Solution.
Can you give more details about the layer names , lines' lengths and colors .... etc ?
Or maybe a sample drawing would do instead of thousand words .
for exaample first line will be continuous linetype , second line hidden , thirth line center and color will be red - cyan - magenta ...
i wanna draw continuosly triple line ... and each line will be in different layer - different color - different line type .... i need an example code
Can not wait for a drawing because I have to go to sleep
(defun c:Test (/ go layers i colors DrawLine p l g) (setq go t layers '("layer1" "layer2" "layer3") ; <= Replace the name of layer to your needs and they must be found in the drawing . ) (setq i 0 colors (list 1 2 3) ; <= Replace the color' numbers as needed . ) (defun DrawLine (p1 p2 layer color) (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2) (cons 8 layer) (cons 62 color) ) ) ) (foreach lay layers (if (not (tblsearch "LAYER" lay)) (progn (alert (strcat "layer : < " lay " > is not found <!>")) (setq go nil) ) ) ) (if (and go (setq l (getdist "\n Specify length of each line :")) (setq g (getdist "\n Specify gap distance between lines :")) (setq p (getpoint "\n Specify point :")) ) (repeat 3 (DrawLine p (polar p 0. l) (car layers) (setq i (1+ i))) (setq p (polar p (* pi 0.5) g)) ) ) (princ) )
Felt like playing around...
(defun c:LO (/ *error* layerlist layers ent cmd obj off dst lay) ;; Alan J. Thompson, 2013.05.08 (vl-load-com) (defun *error* (msg) (and cmd (setvar 'CMDECHO cmd)) (and *AcadDoc* (vla-endundomark *AcadDoc*)) (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,"))) (princ (strcat "\nError: " msg)) ) ) (vla-startundomark (cond (*AcadDoc*) ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))) ) ) (setq layerlist '(("Layer1" 1 "Continuous") ("Layer2" 4 "Hidden") ("Layer3" 6 "Center") ) ) (initget 6) (setq *LO:Dist* (cond ((getreal (strcat "\nSpecify offset distance <" (rtos (cond (*LO:Dist*) ((setq *LO:Dist* 1.)) ) ) ">: " ) ) ) (*LO:Dist*) ) ) (initget 0 "Left Right") (setq *LO:Side* (cond ((getkword (strcat "\nSpecify side on which to draw offsets [Left/Right] <" (cond (*LO:Side*) ((setq *LO:Side* "Left")) ) ">: " ) ) ) (*LO:Side*) ) ) (setq layers (vla-get-layers *AcadDoc*) ent (entlast) cmd (getvar 'CMDECHO) ) (setvar 'CMDECHO 0) (princ "\nSpecify start point: ") (command "_.pline") (setvar 'CMDECHO 1) (while (eq (logand 1 (getvar 'CMDACTIVE)) 1) (command PAUSE)) (if (not (equal ent (setq ent (entlast)))) (progn (setq obj (vlax-ename->vla-object ent) off (if (eq *LO:Side* "Left") -1 1 ) dst 0. ) ;; create layers (foreach layer layerlist (if (not (tblsearch "LAYER" (car layer))) (progn (setq lay (vla-add layers (car layer))) (vla-put-color lay (cadr layer)) (if (tblsearch "LTYPE" (caddr layer)) (vla-put-linetype lay (caddr layer)) ) ) ) ) (vla-put-layer obj (caar layerlist)) (foreach layer (cdr layerlist) (vla-put-layer (car (vlax-invoke obj 'Offset (* (setq dst (+ dst *LO:Dist*)) off))) (car layer) ) ) ) ) (*error* nil) (princ) )
@alanjt_ wrote:Felt like playing around...
Count me in.
(defun c:mln ( / _OffsetTo items ofd InsertAt evenp layersAndColors plines base) ;;; pBe 09May2013 ;;; (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) )
Given the number if lines will vary, i opted not to include the Linetype. Also i limit the number of lines to 12. anything more than that is just carzy...< as if 12 is not 😄 >
HTH