need autolisp

[git_thailand]

need : set 2 layer in mline

Edited February 12, 2015 by git_thailand

[Lt Dan's legs]

Quickly done..

 

I'm not happy with it

 
(defun c:test ( / addpolyline *error* pt p2 pts e _offset1 _offset2 _layer1 _layer2 )
 ;|v set offset and layers here v|;
 (setq _offset1 2.)
 (setq _layer1 "0")

 (setq _offset2 (+ _offset1 0.5))
 (setq _layer2 "Defpoints")

 ;|^ set offset and layers here ^|;
 (vl-load-com)
 (defun addpolyline ( pointslst layer closed flag / e )
   (setq e 
     (entmakex
       (append
         (list
           (cons 0 "LWPOLYLINE")
           (cons 100 "AcDbEntity")
           (cons 100 "AcDbPolyline")
           (cons 90 (length pointslst))
           (cons 70 (if closed 1 0))
           (cons 8 layer)
           (cons 43 0.0)
         )
         (mapcar
           (function
             (lambda ( x ) 
               (if (listp x)(cons 10 x)
                 (cons 42 x)
               )
             )
           ) pointslst
         )
       )
     )
   )
   (if (and e flag)
     (vlax-ename->vla-object e) e
   )
 )
 (defun *error* ( msg )
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **"))
   )
   (princ)
 )

 (if 
   (and (setq pt (getpoint "\nSpecify starting point: "))
     (setq pts (cons pt pts))
   )
   (while (setq p2 (getpoint pt "\nSpecify next point: "))
     (and e (mapcar (function vla-delete) e))
     (
       (lambda ( p )
         (setq e
           (apply (function append)
             (mapcar 
               (function
                 (lambda ( x y / o )
                   (setq o (vlax-invoke p 'Offset y))
                   (vla-put-layer (car o) _layer2)
                   (append (vlax-invoke p 'Offset x) o)
                 ) 
               ) (list _offset1 (- _offset1))
                 (list _offset2 (- _offset2))
             ) 
           )
         ) (vla-delete p)
       ) 
       (addpolyline (setq pts (cons (setq pt p2) pts))
         _layer1 nil t
       )
     )
   )
 )
)

[git_thailand]

thank you , but i hope funtion justify to bottom , top and zero

[Lt Dan's legs]

had a few moments..

 

 
(defun c:test ( / addpolyline *error* p pt p2 pts e _offset1 _offset2 _layer1 _layer2 )
 ;|v set offset and layers here v|;
 (setq _offset1 2.)
 (setq _layer1 "0")
 (setq _offset2  0.5)
 (setq _layer2 "Defpoints")
 ;|^ set offset and layers here ^|;
 (vl-load-com)
 (defun addpolyline ( pointslst layer closed flag / e )
   (setq e 
     (entmakex
       (append
         (list
           (cons 0 "LWPOLYLINE")
           (cons 100 "AcDbEntity")
           (cons 100 "AcDbPolyline")
           (cons 90 (length pointslst))
           (cons 70 (if closed 1 0))
           (cons 8 layer)
           (cons 43 0.0)
         )
         (mapcar
           (function
             (lambda ( x ) 
               (if (listp x)(cons 10 x)
                 (cons 42 x)
               )
             )
           ) pointslst
         )
       )
     )
   )
   (if (and e flag)
     (vlax-ename->vla-object e) e
   )
 )
 (defun *error* ( msg )
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **"))
   )
   (princ)
 )
 (and (not *testcommandjustification*)
   (setq *testcommandjustification* "Center")
 )
 (while
   (and 
     (not pt)
     (not 
       (prompt 
         (strcat "\n\n** Current Justification: " *testcommandjustification* " **")
       )
     )
     (not (initget 1 "Justification"))
     (setq pt (getpoint "\nSpecify starting point or [Justification]: "))
   )
   (cond ( (listp pt) (setq pts (cons pt pts)) )
     (t (initget 1 "Top Bottom Center")
       (setq *testcommandjustification* 
         (getkword "\nSpecify justification [Top/Bottom/Center]: ")
         pt nil
       )
     )
   )
 )
 (while (and pts (setq p2 (getpoint pt "\nSpecify next point: ")))
   (and e (mapcar (function vla-delete) e))
   (
     (lambda ( p )
       (cond 
         ( (eq *testcommandjustification* "Center")
           (setq e
             (apply (function append)
               (mapcar 
                 (function
                   (lambda ( x y / o )
                     (setq o (vlax-invoke p 'Offset y))
                     (vla-put-layer (car o) _layer2)
                     (append (vlax-invoke p 'Offset x) o)
                   ) 
                 ) (list (* 0.5 _offset1) (- (* 0.5 _offset1)))
                   (list (+ (* 0.5 _offset1) _offset2) 
                     (- (+ (* 0.5 _offset1) _offset2))
                   )
               ) 
             )
           ) (vla-delete p)
         ) 
         ( (eq *testcommandjustification* "Bottom")
           (setq e
             (append (list p)
               (mapcar
                 (function 
                   (lambda ( o la )
                     (setq p
                       (car 
                         (vlax-invoke p 'offset o)
                       )
                     )
                     (vla-put-layer p la) p
                   )
                 )
                 (list _offset2 _offset1 _offset2)
                 (list _layer1 _layer1 _layer2)
               )
             )
           )
         )
         ( (eq *testcommandjustification* "Top")
           (setq e
             (append (list p)
               (mapcar
                 (function 
                   (lambda ( o la )
                     (setq p
                       (car 
                         (vlax-invoke p 'offset o)
                       )
                     )
                     (vla-put-layer p la) p
                   )
                 )
                 (list (- _offset2)(- _offset1)(- _offset2))
                 (list _layer1 _layer1 _layer2)
               )
             )
           )
         )
       )
     ) 
     (addpolyline (setq pts (cons (setq pt p2) pts))
       (if (eq *testcommandjustification* "Center") _layer1 _layer2) nil t
     )
   )
 ) (princ)
)

[git_thailand]

thank you . very cool lisp , please insert auto hatch fuction between inner line (layer"0")

Edited September 27, 2011 by git_thailand

[Lt Dan's legs]

I'll tackle that tomorrow.

[Lt Dan's legs]

Let me know if this works for you

 

This lisp looks atrocious!

 
(defun c:test ( / pairpts addpolyline *error* ad as p pt p2 pts e _offset1 _offset2 _layer1 _layer2 o3 ph h )
 ;|v set offset and layers here v|;
 (setq _offset1 2.)
 (setq _layer1 "0")
 (setq _offset2  0.5)
 (setq _layer2 "Defpoints")
 (setq _hatch "ansi31")
 (setq _hatchscale 1.)
 (setq _hatchangle (* pi 0.75))
 ;|^ set offset and layers here ^|;
 (vl-load-com)
   (defun pairpts ( _list / l pt )
   (foreach x (reverse _list)
     (if pt
       (setq l (cons (cons x pt) l) pt nil)
       (setq pt (cons x pt))
     )
   ) l
 )
 (defun addpolyline ( pointslst layer closed flag / e )
   (setq e 
     (entmakex
       (append
         (list
           (cons 0 "LWPOLYLINE")
           (cons 100 "AcDbEntity")
           (cons 100 "AcDbPolyline")
           (cons 90 (length pointslst))
           (cons 70 (if closed 1 0))
           (cons 8 layer)
           (cons 43 0.0)
         )
         (mapcar
           (function
             (lambda ( x ) 
               (if (listp x)(cons 10 x)
                 (cons 42 x)
               )
             )
           ) pointslst
         )
       )
     )
   )
   (if (and e flag)
     (vlax-ename->vla-object e) e
   )
 )
 (defun *error* ( msg )
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **"))
   )
   (princ)
 )
 (defun ad nil
   (setq *acdoc*
     (cond  ( *acdoc* )
       ( (vlax-get (vlax-get-acad-object)
           'ActiveDocument
         )
       ) 
     )
   )
 )
 (defun as nil (ad)
   (cond
     ( (eq AcModelSpace (vlax-get *acdoc* 'ActiveSpace))
       (vlax-get *acdoc* 'ModelSpace)
     )
     ( (vlax-get *acdoc* 'PaperSpace) )
   )
 )
 (and (not *testcommandjustification*)
   (setq *testcommandjustification* "Center")
 )
 (while
   (and 
     (not pt)
     (not 
       (prompt 
         (strcat "\n\n** Current Justification: " *testcommandjustification* " **")
       )
     )
     (not (initget 1 "Justification"))
     (setq pt (getpoint "\nSpecify starting point or [Justification]: "))
   )
   (cond ( (listp pt) (setq pts (cons pt pts)) )
     (t (initget 1 "Top Bottom Center")
       (setq *testcommandjustification* 
         (getkword "\nSpecify justification [Top/Bottom/Center]: ")
         pt nil
       )
     )
   )
 )
 (while (and pts (setq p2 (getpoint pt "\nSpecify next point: ")))
   (and e (mapcar (function vla-delete) e))
   (
     (lambda ( p )
       (cond 
         ( (eq *testcommandjustification* "Center")
           (setq e
             (apply (function append)
               (mapcar 
                 (function
                   (lambda ( x y / o )
                     (setq o (vlax-invoke p 'Offset y))
                     (vla-put-layer (car o) _layer2)
                     (setq o3 
                       (cons 
                         (car
                           (vlax-invoke p 'Offset x)
                         ) o3
                       )
                     ) o
                   ) 
                 ) (list (* 0.5 _offset1) (- (* 0.5 _offset1)))
                   (list (+ (* 0.5 _offset1) _offset2) 
                     (- (+ (* 0.5 _offset1) _offset2))
                   )
               ) 
             )
           ) (vla-delete p)
         ) 
         ( (eq *testcommandjustification* "Bottom")
           (setq e
             (append (list p)
               (vl-remove-if (function not)
                 (mapcar
                   (function 
                     (lambda ( o la )
                       (setq p
                         (car 
                           (vlax-invoke p 'offset o)
                         )
                       )
                       (vla-put-layer p la)
                       (if (eq la _layer1)
                         (progn (setq o3(cons p o3)) nil)
                         p
                       )
                     )
                   )
                   (list _offset2 _offset1 _offset2)
                   (list _layer1 _layer1 _layer2)
                 )
               )
             )
           )
         )
         ( (eq *testcommandjustification* "Top")
           (setq e
             (append (list p)
               (vl-remove-if (function not)
                 (mapcar
                   (function 
                     (lambda ( o la )
                       (setq p
                         (car 
                           (vlax-invoke p 'offset o)
                         )
                       )
                       (vla-put-layer p la)
                       (if (eq la _layer1)
                         (progn (setq o3(cons p o3)) nil)
                         p
                       )
                     )
                   )
                   (list (- _offset2)(- _offset1)(- _offset2))
                   (list _layer1 _layer1 _layer2)
                 )
               )
             )
           )
         )
       )
       (setq e
         (cons 
           (setq ph
             (addpolyline
               (append
                 (pairpts (vlax-get (car o3) 'Coordinates))
                 (reverse (pairpts (vlax-get (cadr o3) 'Coordinates)))
               ) _layer1 t t
             )
           ) e
         )
       )(mapcar (function vla-delete) o3)
       (setq o3 nil)  
       (setq h 
         (vla-addhatch (as) 
           acHatchPatternTypePredefined _hatch :vlax-true
         )
       )
       (vlax-invoke h 'AppendOuterLoop (list ph))
       (vlax-invoke h 'Evaluate)
       (vla-put-patternscale h _hatchscale)
       (vla-put-patternangle h _hatchangle)
       (vla-put-layer h _layer1)
       (setq e (cons h e))
     ) 
     (addpolyline (setq pts (cons (setq pt p2) pts))
       (if (eq *testcommandjustification* "Center") _layer1 _layer2) nil t
     )
   )
 ) (vla-regen (ad) acactiveviewport) (princ)
)

Edited September 27, 2011 by Lt Dan's legs

[git_thailand]

yes. it work on setting layer and please set hatch angle 135 degree. very thank you.

[Lt Dan's legs]

Code updated above

[git_thailand]

very thank you guy. +++++

[git_thailand]

Lt Dan's legs help me lisp for drawn beam plan.

- 2line in layer beam

- text in layer text

 

 

[git_thailand]

 

pic