Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

how to draw triple or more lines

8 REPLIES 8
SOLVED
Reply
Message 1 of 9
E.S.7.9
1577 Views, 8 Replies

how to draw triple or more lines

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

8 REPLIES 8
Message 2 of 9
_Tharwat
in reply to: E.S.7.9

Can you give more details about the layer names , lines' lengths and colors .... etc ?

Message 3 of 9
_Tharwat
in reply to: E.S.7.9

Or maybe a sample drawing would do instead of thousand words . Smiley Happy

Message 4 of 9
alanjt_
in reply to: _Tharwat

What about an MLine?

Message 5 of 9
E.S.7.9
in reply to: _Tharwat

for exaample first line will be continuous linetype , second line hidden , thirth line center and color will be red - cyan - magenta ...

 

 

Message 6 of 9
E.S.7.9
in reply to: E.S.7.9

i wanna draw continuosly triple line ... and each line will be in different layer - different color - different line type .... i need an example code

Message 7 of 9
_Tharwat
in reply to: E.S.7.9

Can not wait for a drawing because I have to go to sleep Smiley Very Happy

 

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

 

Message 8 of 9
alanjt_
in reply to: _Tharwat

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

 

Message 9 of 9
pbejse
in reply to: alanjt_


@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

 

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost