topic Re: cashing pipe [polygon] in Visual LISP, AutoLISP and General Customization Forum

cashing pipe [polygon]

JN05 — Fri, 04 Dec 2020 07:53:42 GMT

Good day.

I am very grateful for any help.

I was faced with another tedious task that I have to do for several projects on our team.

Can you support me with the code that the "casing pipe" will draw? In the attached sketch "cashing_pipe" the yellow dashed line is this item. Ultimately, the element may be a polygon, as in the example "cashing_pipe_collapse".
Using a multiline might be one solution, but I'd like to explore other possibilities.

Problem: Draw a 1m wide polygon from to an indicated point.

Best regards and thank you for your help and directions to solve the problem.

Thanks for any help.

Re: cashing pipe [polygon]

hak_vz — Fri, 04 Dec 2020 12:17:34 GMT

Try this

(defun c:cov2pipe ( / e eo coords a b c d pt vlapt e1 e2) ; Select lwpolyline entity that is a centerline of pipe object ; and convert it to pipe ; hak_vz 04.12.2020 (cond ((and (setq e (car(entsel "\nSelect pipe >")))) (setq np (- (cdr (assoc 90 (entget e))) 1)) (setq eo (vlax-ename->vla-object e)) (setq coords (vlax-get eo 'Coordinates)) (setq n (length coords)) (setq a (list (car coords)(cadr coords))) (setq b (list (caddr coords)(cadddr coords))) (setq c (list (nth (- n 4) coords)(nth (- n 3) coords))) (setq d (list (nth (- n 2) coords)(last coords))) (setq pt (polar a (angle b a) 0.5)) (setq vlapt (vlax-make-safearray vlax-vbdouble '(0 . 1))) (vlax-safearray-fill vlapt pt) (vla-put-Coordinate eo 0 vlapt) (setq pt (polar d (angle c d) 0.5)) (setq vlapt (vlax-make-safearray vlax-vbdouble '(0 . 1))) (vlax-safearray-fill vlapt pt) (vla-put-Coordinate eo np vlapt) (vla-Offset eo 0.5) (setq e1 (entlast)) (vla-Offset eo -0.5) (setq e2 (entlast)) (setvar 'cmdecho 0) (command "_.pedit" "m" e1 e2 "" "J" 50) (setvar 'cmdecho 1) (entdel e) ; put a comment infront this line if you want to retain centerline ) ) (princ) )

Create a lwpolyline that represents a centerline of polyline i.e. connect points 1 to n, then use cov2pipe to convert

to shape you want. Place it to layer wit predefined linetype and that's it. At the end select all object in that layer and

select option "enable linetype generation".

Re: cashing pipe [polygon]

JN05 — Fri, 04 Dec 2020 13:07:56 GMT

Thanks for the tip. cov2pipe works fine. However, there is an additional step to be performed. You need to delete the polyline on which the pipes are drawn. Additionally, the tips (yellow) do not close. It would be most convenient to indicate points (dots) marked in red.

Beloved, look, maybe it is possible to modify the @hak_vz code so that there is no line in the middle and it is closed.

Thank you very much for all your help.

Re: cashing pipe [polygon]

hak_vz — Fri, 04 Dec 2020 13:17:25 GMT

@JN05Attach sample drawing so I can test it. I will add a code to create donuts at point location.

Re: cashing pipe [polygon]

marko_ribar — Fri, 04 Dec 2020 13:27:28 GMT

Here, try this... You must specify linetype and linetype scale prior running routine...

(defun c:extopenlinearpolygon ( / *error* LM:PolyOutline unit plw plg lw lwx lp lpx sp ssp ep eep pl spl epl spln epln )

  (defun *error* ( m )
    (if plw
      (setvar 'plinewid plw)
    )
    (if plg
      (setvar 'plinegen plg)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  ;;------------------=={ LWPolyline Outline }==----------------;;
  ;;                                                            ;;
  ;;  Creates an LWPolyline surrounding the boundary of an      ;;
  ;;  LWPolyline with varying widths. Currently restricted to   ;;
  ;;  LWPolyline vertices with zero bulge.                      ;;
  ;;------------------------------------------------------------;;
  ;;  Author: Lee Mac, Copyright   2011 - www.lee-mac.com       ;;
  ;;------------------------------------------------------------;;
  ;;  Arguments:                                                ;;
  ;;  ent - Entity name of LWPolyline                           ;;
  ;;------------------------------------------------------------;;
  ;;  Returns:  List of Entity name(s) of outline LWPolyline(s) ;;
  ;;------------------------------------------------------------;;

  (defun LM:PolyOutline ( ent / _vertices lst )

    (defun _vertices ( e )
      (if (setq e (member (assoc 10 e) e))
        (cons
          (list
            (cdr (assoc 10 e))
            (cdr (assoc 40 e))
            (cdr (assoc 41 e))
          )
          (_vertices (cdr e))
        )
      )
    )

    (setq
      ent (entget ent)
      lst (_vertices ent)
      lst (apply 'mapcar
            (cons
              (function
                (lambda ( a b )
                  (
                    (lambda ( c )
                      (mapcar
                        (function
                          (lambda ( d )
                            (mapcar
                              (function
                                (lambda ( e f )
                                  (mapcar 'd (car e)
                                    (mapcar
                                      (function
                                        (lambda ( g ) (* g (/ f 2.0)))
                                      )
                                      c
                                    )
                                  )
                                )
                              )
                              (list a b) (cdr a)
                            )
                          )
                        )
                        (list + -)
                      )
                    )
                    (
                      (lambda ( v / n )
                        (setq v (list (- (cadr v)) (car v) 0.0)
                              n (distance '(0. 0.) v)
                        )
                        (if (equal 0.0 n 1e-14)
                          (list  0.0 0.0 0.0)
                          (mapcar '/ v (list n n n))
                        )
                      )
                      (mapcar '- (car a) (car b))
                    )
                  )
                )
              )
              (if (= 1 (logand 1 (cdr (assoc 70 ent))))
                (list
                  (cons (last lst) lst)
                  (append lst (list (car lst)))
                )
                (list lst (cdr lst))
              )
            )
          )
      lst (
            (lambda ( a )
              (if (zerop (logand 1 (cdr (assoc 70 ent))))
                (append
                  (list (mapcar 'car  (car  lst)))
                  a
                  (list (mapcar 'cadr (last lst)))
                )
                a
              )
            )
            (apply 'append
              (mapcar
                (function
                  (lambda ( a b / c )
                    (if
                      (setq c
                        (apply 'append
                          (mapcar
                            (function
                              (lambda ( d e / f )
                                (if (setq f (inters (car d) (cadr d) (car e) (cadr e) nil))
                                  (list f)
                                )
                              )
                            )
                            a b
                          )
                        )
                      )
                      (list c)
                    )
                  )
                )
                lst (cdr lst)
              )
            )
          )
    )
    (mapcar
      (function
        (lambda ( a )
          (entmakex
            (append
              (subst (cons 43 0.0) (assoc 43 ent)
                (subst (cons 70 (logior 1 (cdr (assoc 70 ent)))) (assoc 70 ent)
                  (subst (cons 90 (length a)) (assoc 90 ent)
                    (reverse (member (assoc 39 ent) (reverse ent)))
                  )
                )
              )
              (mapcar '(lambda ( p ) (cons 10 p)) a) (list (assoc 210 ent))
            )
          )
        )
      )
      (
        (lambda ( a b )
          (if (zerop (logand 1 (cdr (assoc 70 ent))))
            (list
              (append
                (if (equal (car a) (last b) 1e-8)
                  (setq a (cdr a))
                  a
                )
                (if (equal (car b) (last a) 1e-8)
                  (setq b (cdr b))
                  b
                )
              )
            )
            (list a b)
          )
        )
        (mapcar 'car lst) (reverse (mapcar 'cadr lst))
      )
    )
  )

  (defun unit ( v / d )
    (if (not (equal (setq d (distance '(0.0 0.0 0.0) v)) 0.0 1e-8))
      (mapcar '(lambda ( x ) (/ x d)) v)
    )
  )

  (if (null w)
    (setq w 1.0)
  )
  (initget 6)
  (setq w (cond ( (getdist (strcat "\nPick or specify width of linear polygon <" (rtos w) "> : ")) ) ( w )))
  (if (null d)
    (setq d 0.5)
  )
  (initget 6)
  (setq d (cond ( (getdist (strcat "\nPick or specify extension of linear polygon <" (rtos d) "> : ")) ) ( d )))
  (setq plw (getvar 'plinewid))
  (setvar 'plinewid w)
  (setq plg (getvar 'plinegen))
  (setvar 'plinegen 1)
  (prompt "\nPick or specify starting point : ")
  (vl-cmdf "_.PLINE")
  (while (< 0 (getvar 'cmdactive))
    (vl-cmdf "\\")
  )
  (setq lw (entlast))
  (setq lp (car (LM:PolyOutline lw)))
  (setq sp (cdr (assoc 10 (setq lwx (entget lw)))))
  (setq ssp (cdr (assoc 10 (cdr (member (assoc 10 lwx) lwx)))))
  (setq ep (cdr (assoc 10 (reverse lwx))))
  (setq eep (cdr (assoc 10 (cdr (member (assoc 10 (reverse lwx)) (reverse lwx))))))
  (setq pl (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (setq lpx (entget lp)))))
  (setq spl (vl-sort pl '(lambda ( a b ) (< (distance a sp) (distance b sp)))))
  (setq spl (list (car spl) (cadr spl)))
  (setq epl (vl-sort pl '(lambda ( a b ) (< (distance a ep) (distance b ep)))))
  (setq epl (list (car epl) (cadr epl)))
  (setq spln (mapcar '(lambda ( x ) (mapcar '+ x (mapcar '* (unit (mapcar '- sp ssp)) (list d d d)))) spl))
  (setq epln (mapcar '(lambda ( x ) (mapcar '+ x (mapcar '* (unit (mapcar '- ep eep)) (list d d d)))) epl))
  (setq lpx (subst (cons 10 (car spln)) (cons 10 (car spl)) lpx))
  (setq lpx (subst (cons 10 (cadr spln)) (cons 10 (cadr spl)) lpx))
  (setq lpx (subst (cons 10 (car epln)) (cons 10 (car epl)) lpx))
  (setq lpx (subst (cons 10 (cadr epln)) (cons 10 (cadr epl)) lpx))
  (entupd (cdr (assoc -1 (entmod lpx))))
  (entdel lw)
  (*error* nil)
)

Re: cashing pipe [polygon]

hak_vz — Fri, 04 Dec 2020 14:06:14 GMT

(defun c:cov2pipe ( / e eo coords a b c d pt vlapt e1 e2) ; Select lwpolyline entity that is a centerline of pipe object ; and convert it to pipe ; hak_vz 04.12.2020 (cond ((and (setq e (car(entsel "\nSelect pipe >")))) (setq np (- (cdr (assoc 90 (entget e))) 1)) (setq eo (vlax-ename->vla-object e)) (setq coords (vlax-get eo 'Coordinates)) (setq n (length coords)) (setq a (list (car coords)(cadr coords))) (setq b (list (caddr coords)(cadddr coords))) (setq c (list (nth (- n 4) coords)(nth (- n 3) coords))) (setq d (list (nth (- n 2) coords)(last coords))) (setq pt (polar a (angle b a) 0.5)) (setq vlapt (vlax-make-safearray vlax-vbdouble '(0 . 1))) (vlax-safearray-fill vlapt pt) (vla-put-Coordinate eo 0 vlapt) (setq pt (polar d (angle c d) 0.5)) (setq vlapt (vlax-make-safearray vlax-vbdouble '(0 . 1))) (vlax-safearray-fill vlapt pt) (vla-put-Coordinate eo np vlapt) (vla-Offset eo 0.5) (setq e1 (entlast)) (vla-Offset eo -0.5) (setq e2 (entlast)) (setvar 'cmdecho 0) (command "_.pedit" "m" e1 e2 "" "J" "J" "A" 50 "") (setvar 'cmdecho 1) (entdel e) ) ) (princ) )

Re: cashing pipe [polygon]

marko_ribar — Fri, 04 Dec 2020 14:36:14 GMT

Now I coded when in routine, CAD don't add linetype to previewing drawing polyline - only to add linetype to finished resulting outlinear polygonal lwpolyline... If you are satisfied, you can reply (I don't quite know how to make it better...)...

(defun c:extopenlinearpolygon ( / *error* LM:PolyOutline unit plw plg clt lw lwx lp lpx sp ssp ep eep pl spl epl spln epln )

  (defun *error* ( m )
    (if plw
      (setvar 'plinewid plw)
    )
    (if plg
      (setvar 'plinegen plg)
    )
    (if clt
      (setvar 'celtype clt)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  ;;------------------=={ LWPolyline Outline }==----------------;;
  ;;                                                            ;;
  ;;  Creates an LWPolyline surrounding the boundary of an      ;;
  ;;  LWPolyline with varying widths. Currently restricted to   ;;
  ;;  LWPolyline vertices with zero bulge.                      ;;
  ;;------------------------------------------------------------;;
  ;;  Author: Lee Mac, Copyright   2011 - www.lee-mac.com       ;;
  ;;------------------------------------------------------------;;
  ;;  Arguments:                                                ;;
  ;;  ent - Entity name of LWPolyline                           ;;
  ;;------------------------------------------------------------;;
  ;;  Returns:  List of Entity name(s) of outline LWPolyline(s) ;;
  ;;------------------------------------------------------------;;

  (defun LM:PolyOutline ( ent / _vertices lst )

    (defun _vertices ( e )
      (if (setq e (member (assoc 10 e) e))
        (cons
          (list
            (cdr (assoc 10 e))
            (cdr (assoc 40 e))
            (cdr (assoc 41 e))
          )
          (_vertices (cdr e))
        )
      )
    )

    (setq
      ent (entget ent)
      lst (_vertices ent)
      lst (apply 'mapcar
            (cons
              (function
                (lambda ( a b )
                  (
                    (lambda ( c )
                      (mapcar
                        (function
                          (lambda ( d )
                            (mapcar
                              (function
                                (lambda ( e f )
                                  (mapcar 'd (car e)
                                    (mapcar
                                      (function
                                        (lambda ( g ) (* g (/ f 2.0)))
                                      )
                                      c
                                    )
                                  )
                                )
                              )
                              (list a b) (cdr a)
                            )
                          )
                        )
                        (list + -)
                      )
                    )
                    (
                      (lambda ( v / n )
                        (setq v (list (- (cadr v)) (car v) 0.0)
                              n (distance '(0. 0.) v)
                        )
                        (if (equal 0.0 n 1e-14)
                          (list  0.0 0.0 0.0)
                          (mapcar '/ v (list n n n))
                        )
                      )
                      (mapcar '- (car a) (car b))
                    )
                  )
                )
              )
              (if (= 1 (logand 1 (cdr (assoc 70 ent))))
                (list
                  (cons (last lst) lst)
                  (append lst (list (car lst)))
                )
                (list lst (cdr lst))
              )
            )
          )
      lst (
            (lambda ( a )
              (if (zerop (logand 1 (cdr (assoc 70 ent))))
                (append
                  (list (mapcar 'car  (car  lst)))
                  a
                  (list (mapcar 'cadr (last lst)))
                )
                a
              )
            )
            (apply 'append
              (mapcar
                (function
                  (lambda ( a b / c )
                    (if
                      (setq c
                        (apply 'append
                          (mapcar
                            (function
                              (lambda ( d e / f )
                                (if (setq f (inters (car d) (cadr d) (car e) (cadr e) nil))
                                  (list f)
                                )
                              )
                            )
                            a b
                          )
                        )
                      )
                      (list c)
                    )
                  )
                )
                lst (cdr lst)
              )
            )
          )
    )
    (mapcar
      (function
        (lambda ( a )
          (entmakex
            (append
              (subst (cons 43 0.0) (assoc 43 ent)
                (subst (cons 70 (logior 1 (cdr (assoc 70 ent)))) (assoc 70 ent)
                  (subst (cons 90 (length a)) (assoc 90 ent)
                    (reverse (member (assoc 39 ent) (reverse ent)))
                  )
                )
              )
              (mapcar '(lambda ( p ) (cons 10 p)) a) (list (assoc 210 ent))
            )
          )
        )
      )
      (
        (lambda ( a b )
          (if (zerop (logand 1 (cdr (assoc 70 ent))))
            (list
              (append
                (if (equal (car a) (last b) 1e-8)
                  (setq a (cdr a))
                  a
                )
                (if (equal (car b) (last a) 1e-8)
                  (setq b (cdr b))
                  b
                )
              )
            )
            (list a b)
          )
        )
        (mapcar 'car lst) (reverse (mapcar 'cadr lst))
      )
    )
  )

  (defun unit ( v / d )
    (if (not (equal (setq d (distance '(0.0 0.0 0.0) v)) 0.0 1e-8))
      (mapcar '(lambda ( x ) (/ x d)) v)
    )
  )

  (if (null w)
    (setq w 1.0)
  )
  (initget 6)
  (setq w (cond ( (getdist (strcat "\nPick or specify width of linear polygon <" (rtos w) "> : ")) ) ( w )))
  (if (null d)
    (setq d 0.5)
  )
  (initget 6)
  (setq d (cond ( (getdist (strcat "\nPick or specify extension of linear polygon <" (rtos d) "> : ")) ) ( d )))
  (setq plw (getvar 'plinewid))
  (setvar 'plinewid w)
  (setq plg (getvar 'plinegen))
  (setvar 'plinegen 0)
  (setq clt (getvar 'celtype))
  (setvar 'celtype "Continuous")
  (prompt "\nPick or specify starting point : ")
  (vl-cmdf "_.PLINE")
  (while (< 0 (getvar 'cmdactive))
    (vl-cmdf "\\")
  )
  (setq lw (entlast))
  (setq lp (car (LM:PolyOutline lw)))
  (setq sp (cdr (assoc 10 (setq lwx (entget lw)))))
  (setq ssp (cdr (assoc 10 (cdr (member (assoc 10 lwx) lwx)))))
  (setq ep (cdr (assoc 10 (reverse lwx))))
  (setq eep (cdr (assoc 10 (cdr (member (assoc 10 (reverse lwx)) (reverse lwx))))))
  (setq pl (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (setq lpx (entget lp)))))
  (setq spl (vl-sort pl '(lambda ( a b ) (< (distance a sp) (distance b sp)))))
  (setq spl (list (car spl) (cadr spl)))
  (setq epl (vl-sort pl '(lambda ( a b ) (< (distance a ep) (distance b ep)))))
  (setq epl (list (car epl) (cadr epl)))
  (setq spln (mapcar '(lambda ( x ) (mapcar '+ x (mapcar '* (unit (mapcar '- sp ssp)) (list d d d)))) spl))
  (setq epln (mapcar '(lambda ( x ) (mapcar '+ x (mapcar '* (unit (mapcar '- ep eep)) (list d d d)))) epl))
  (setq lpx (subst (cons 10 (car spln)) (cons 10 (car spl)) lpx))
  (setq lpx (subst (cons 10 (cadr spln)) (cons 10 (cadr spl)) lpx))
  (setq lpx (subst (cons 10 (car epln)) (cons 10 (car epl)) lpx))
  (setq lpx (subst (cons 10 (cadr epln)) (cons 10 (cadr epl)) lpx))
  (setq lpx (subst (cons 70 (+ 128 (cdr (assoc 70 lpx)))) (assoc 70 lpx) lpx))
  (setq lpx (subst (cons 6 clt) (assoc 6 lpx) lpx))
  (entupd (cdr (assoc -1 (entmod lpx))))
  (entdel lw)
  (*error* nil)
)

Re: cashing pipe [polygon]

hak_vz — Fri, 04 Dec 2020 17:30:21 GMT

Re: cashing pipe [polygon]

hak_vz — Fri, 04 Dec 2020 17:33:08 GMT

I hope this is it

(defun c:cov2pipe ( / e eo a b c d pt n vlapt e1 e2 coords ptlist adoc take plusp width ext np) ; Select lwpolyline entity that is a centerline of pipe object ; and convert it to pipe ; hak_vz 04.12.2020 (defun take (amount lst / ret) (cond ((and (plusp amount) (and (> amount 0) (<= amount (length lst))) (listp lst))(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst)))))))) (defun plusp (num) (cond ((numberp num) (>= num 0.0)))) (setq adoc (vla-get-activedocument (vlax-get-acad-object))) (cond ((and (setq e (car(entsel "\nSelect pipe >")))) (vla-endundomark adoc) (vla-startundomark adoc) (setvar 'cmdecho 0) (setq width (* 0.5 (getreal "\nPipe diameter >"))) (setq ext (getreal "\nPipe extension length >")) (setq pd (* 0.5 (getreal "\nPoint diameter >"))) (setq np (- (cdr (assoc 90 (entget e))) 1)) (setq eo (vlax-ename->vla-object e)) (setq coords (vlax-get eo 'Coordinates)) (setq ptlist (reverse ptlist)) (setq n (length coords)) (setq a (list (car coords)(cadr coords))) (setq b (list (caddr coords)(cadddr coords))) (setq c (list (nth (- n 4) coords)(nth (- n 3) coords))) (setq d (list (nth (- n 2) coords)(last coords))) (setq pt (polar a (angle b a) ext)) (setq vlapt (vlax-make-safearray vlax-vbdouble '(0 . 1))) (vlax-safearray-fill vlapt pt) (vla-put-Coordinate eo 0 vlapt) (setq pt (polar d (angle c d) ext)) (setq vlapt (vlax-make-safearray vlax-vbdouble '(0 . 1))) (vlax-safearray-fill vlapt pt) (vla-put-Coordinate eo np vlapt) (vla-Offset eo width) (setq e1 (entlast)) (vla-Offset eo (* -1 width)) (setq e2 (entlast)) (command "_.pedit" "m" e1 e2 "" "J" "J" "A" (* 4 width) "") (entdel e) (while coords (setq ptlist (cons (take 2 coords) ptlist) coords (cddr coords))) (while ptlist (command "_.donut" 0 pd "_non" (car ptlist) "") (command "chprop" (entlast) "" "C" 1 "" )(setq ptlist (cdr ptlist))) (setvar 'cmdecho 1) (vla-endundomark adoc) ) ) (princ) )

Re: cashing pipe [polygon]

JN05 — Fri, 04 Dec 2020 18:07:10 GMT

@hak_vz Thank you for your time. I test, but it does not work out like in your screenshot. There are still no line endings and the centerline does not disappear.
I mean, you just type> pipe diameter 1 and the lisp does the same for me as yours. It doesn't work for me. Take a look ...

Polecenie: COV2PIPE

Select pipe >
Pipe diameter >1

Pipe extension length >1

Point diameter >1

Re: cashing pipe [polygon]

hak_vz — Fri, 04 Dec 2020 18:20:39 GMT

please add sample drawing.

which version of acad you use. In acad 2018 everything works ok

Re: cashing pipe [polygon]

hak_vz — Fri, 04 Dec 2020 18:58:48 GMT

Eventually try this. In your screenshot UCS was not set to World

(defun c:cov2pipe ( / e eo a b c d pt n vlapt e1 e2 coords ptlist adoc take plusp width ext np) ; Select lwpolyline entity that is a centerline of pipe object ; and convert it to pipe ; hak_vz 04.12.2020 (defun take (amount lst / ret) (cond ((and (plusp amount) (and (> amount 0) (<= amount (length lst))) (listp lst))(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst)))))))) (defun plusp (num) (cond ((numberp num) (>= num 0.0)))) (setq adoc (vla-get-activedocument (vlax-get-acad-object))) (cond ((and (setq e (car(entsel "\nSelect pipe >")))) (vla-endundomark adoc) (vla-startundomark adoc) (setvar 'cmdecho 0) (command "_.UCS" "W") (setq width (* 0.5 (getreal "\nPipe diameter >"))) (setq ext (getreal "\nPipe extension length >")) (setq pd (* 0.5 (getreal "\nPoint diameter >"))) (setq np (- (cdr (assoc 90 (entget e))) 1)) (setq eo (vlax-ename->vla-object e)) (setq coords (vlax-get eo 'Coordinates)) (setq ptlist (reverse ptlist)) (setq n (length coords)) (setq a (list (car coords)(cadr coords))) (setq b (list (caddr coords)(cadddr coords))) (setq c (list (nth (- n 4) coords)(nth (- n 3) coords))) (setq d (list (nth (- n 2) coords)(last coords))) (setq pt (polar a (angle b a) ext)) (setq vlapt (vlax-make-safearray vlax-vbdouble '(0 . 1))) (vlax-safearray-fill vlapt pt) (vla-put-Coordinate eo 0 vlapt) (setq pt (polar d (angle c d) ext)) (setq vlapt (vlax-make-safearray vlax-vbdouble '(0 . 1))) (vlax-safearray-fill vlapt pt) (vla-put-Coordinate eo np vlapt) (vla-Offset eo width) (setq e1 (entlast)) (vla-Offset eo (* -1 width)) (setq e2 (entlast)) (initcommandversion) (command "_.pedit" "m" e1 e2 "" "J" "J" "A" (* 4 width) "") (entdel e) (while coords (setq ptlist (cons (take 2 coords) ptlist) coords (cddr coords))) (while ptlist (command "_.donut" 0 pd "_non" (car ptlist) "") (initcommandversion) (command "chprop" (entlast) "" "C" 1 "" )(setq ptlist (cdr ptlist))) (command "_.UCS" "P") (setvar 'cmdecho 1) (vla-endundomark adoc) ) ) (princ) )

Re: cashing pipe [polygon]

Kent1Cooper — Fri, 04 Dec 2020 18:58:34 GMT

You may be able to use OffsetBothSidesClose.lsp with its OBSC command, >here<.

Re: cashing pipe [polygon]

JN05 — Sat, 05 Dec 2020 14:53:34 GMT

@hak_vz thank you for your time. It's better now. The lines are drawing. They don't just close at the ends. Will you see why this is happening? Help please.
Best regards.

Re: cashing pipe [polygon]

marko_ribar — Sat, 05 Dec 2020 15:07:30 GMT

@JN05

Is your drawing lines in yellow on picture?

If yes, then I suggest that check routine for calculating additional points - maybe you turned OSNAP on and CAD therefore can't aquire correct locations... If you though also set linetype and linetype scale to unappropriate values, you may get dashes and closing line as smaller may be invisible (gap between dashes)... I don't know why are you ignoring my postings... It should work well for your cases (linear paths)... Also note that your drawn paths shouldn't self intersect as this will bring errors with (vla-offset) - curves breaks into 2 or more solutions... Please, do check my versions... If you want no extensions, just change (initget 6) to (initget 4) and line : (if (null d) (setq d 0.0)) at the beggining of code...

Regards, M.R.

Re: cashing pipe [polygon]

JN05 — Sat, 05 Dec 2020 15:33:32 GMT

Thank you very much. This is what I was looking for. Drawing pipes by pointing with points. Would you have any more time for me? Could the ends of the tube be ellipses like in my screenshot? Thanks again for your time. I'm sorry I didn't check your code right away. Best wishes.

Re: cashing pipe [polygon]

hak_vz — Sat, 05 Dec 2020 17:19:33 GMT

@JN05 wrote:
@hak_vz thank you for your time. It's better now. The lines are drawing. They don't just close at the ends. Will you see why this is happening? Help please.
Best regards.

Sorry @JN05 but I will not. Script is working almost perfectly at my side and I can't find an error as long as you don't answer previous request. Sample file, what version of Acad (or any other cad) you use.

Re: cashing pipe [polygon]

JN05 — Sat, 05 Dec 2020 17:26:55 GMT

Polecenie: COV2PIPE
Select pipe >1
Pipe diameter >1
Pipe extension length >1
Point diameter >1

*Niewłaściwy wybór*
Oczekiwany punkt lub
okNo/oStatni/prZetnij/KOSTKA/WSzystko/krawęDź/OWbok/ZWbok/Wiele]:
; błąd: Funkcję anulowano

Wybierz polilinię lub [Wiele]:
Podaj opcję
[Zamknij/Dołącz/Szerokość/Edwierzch/Wstaw/splaJn/Polilinia/rodzajLinii/ODwróć/Cofaj]:

Re: cashing pipe [polygon]

hak_vz — Sat, 05 Dec 2020 17:39:52 GMT

@JN05Problem is probably with function pedit

(command "_.pedit" "m" e1 e2 "" "J" "J" "A" (* 4 width) "")

Offset a polyline and use command pedit at your side to find proper option to join.

To test what is your pipe center line (lwpoly or 3dpoly) run following function and copy function result

(defun c:aa nil (cdr (assoc 0 (entget(car(entsel "\nSelect polyline >"))))))

For my code to run properly we need an lwpolyline

Re: cashing pipe [polygon]

hak_vz — Sat, 05 Dec 2020 18:35:54 GMT

@JN05Here you have a version that creates ellipse end at both sides and marks points

If you find it works, select it as a solution.

Since @marko_ribar and @Kent1Cooper also provided their solutions that answer your original request, select them as solution too.

(defun c:cov2pipeEllipse ( / );e eo a b c d pt n vlapt e1 e2 coords ptlist adoc take plusp width ext np ; Select lwpolyline entity that is a centerline of pipe object ; and convert it to pipe ; hak_vz 04.12.2020 (defun take (amount lst / ret) (cond ((and (plusp amount) (and (> amount 0) (<= amount (length lst))) (listp lst))(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst)))))))) (defun plusp (num) (cond ((numberp num) (>= num 0.0)))) (setq adoc (vla-get-activedocument (vlax-get-acad-object))) (cond ((and (setq e (car(entsel "\nSelect pipe >")))) (vla-endundomark adoc) (vla-startundomark adoc) (setvar 'cmdecho 0) (command "_.UCS" "W") (setq width (* 0.5 (getreal "\nPipe diameter >"))) (setq ext (getreal "\nPipe extension length >")) (setq pd (* 0.5 (getreal "\nPoint diameter >"))) (setq np (- (cdr (assoc 90 (entget e))) 1)) (setq eo (vlax-ename->vla-object e)) (setq coords (vlax-get eo 'Coordinates)) (setq ptlist (reverse ptlist)) (setq n (length coords)) (setq a (list (car coords)(cadr coords))) (setq b (list (caddr coords)(cadddr coords))) (setq c (list (nth (- n 4) coords)(nth (- n 3) coords))) (setq d (list (nth (- n 2) coords)(last coords))) (setq pt (polar a (angle b a) ext)) (setq vlapt (vlax-make-safearray vlax-vbdouble '(0 . 1))) (vlax-safearray-fill vlapt pt) (vla-put-Coordinate eo 0 vlapt) (setq pt (polar d (angle c d) ext)) (setq vlapt (vlax-make-safearray vlax-vbdouble '(0 . 1))) (vlax-safearray-fill vlapt pt) (vla-put-Coordinate eo np vlapt) (vla-Offset eo width) (setq e1 (entlast)) (vla-Offset eo (* -1 width)) (setq e2 (entlast)) (setq eo1 (vlax-ename->vla-object e1)) (setq eo2 (vlax-ename->vla-object e2)) (setq a (vlax-curve-getstartpoint eo1) b (vlax-curve-getendpoint eo1)) (setq c (vlax-curve-getstartpoint eo2) d (vlax-curve-getendpoint eo2)) (command "_.ellipse" "non" a "non" c (* 0.25 (distance a c))) (command "_.ellipse" "non" b "non" d (* 0.25 (distance b d))) (while coords (setq ptlist (cons (take 2 coords) ptlist) coords (cddr coords))) (while ptlist (command "_.donut" 0 pd "_non" (car ptlist) "") (initcommandversion) (command "chprop" (entlast) "" "C" 1 "" )(setq ptlist (cdr ptlist))) (command "_.UCS" "P") (setvar 'cmdecho 1) (vla-endundomark adoc) ) ) (princ) )