Revcloud around polyline object, on both sides but retain polyline

[Monty Lisp]

Hi all, 

 

I'm trying to figure out if it is possible to use revcloud command to draw a revcloud around a (poly)line. I know you can use revcloud and select an object, but this converts the line to a revcloud line and only on one side. The goal is to simply use the command to select a line and it draws a revcloud around the line (on both sides) while retaining the object.

 

I know I can change the DELOBJ system variable but this also changes the behavior of other functions. 

 

Is this something possible without LISP or only with LISP? Also it feels like this should be solved already but I cannot find the solution on the web. Hope someone can help me with this. 

[Tsuky]

Quote

Is this something possible without LISP or only with LISP?

Yes, you can try this.

(vl-load-com)
(defun l-coor2l-pt (lst flag / )
  (if lst
    (cons
      (list
        (car lst)
        (cadr lst)
        (if flag
          (+ (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) (caddr lst))
          (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0)
        )
      )
      (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag)
    )
  )
)
(defun c:revcloud_pl ( / js AcDoc Space n ent vla_obj l_blg1 l_blg2 v l_blg e_width ename l_pt nw_pl)
  (initget 7)
  (setq e_width (getdist "\nRevision Cloud Width: "))
  (princ "\nSelect polylines to review")
  (setq js
    (ssget
      (list
        (cons 0 "*POLYLINE")
        (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
        (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
        (cons -4 "<NOT")
         (cons -4 "&") (cons 70 127)
        (cons -4 "NOT>")
      )
    )
  )
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (eq (getvar "CVPORT") 1)
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
  )
  (cond
    (js
      (repeat (setq n (sslength js))
        (setq
          ent (ssname js (setq n (1- n)))
          vla_obj (vlax-ename->vla-object ent)
          l_blg1 nil
          l_blg2 nil
        )
        (cond
          ((not (vl-catch-all-error-p (vl-catch-all-apply 'vla-Offset (list vla_obj (* 0.5 e_width)))))
            (setq
              ename (vlax-ename->vla-object (entlast))
              l_pt
              (l-coor2l-pt
                (vlax-get ename 'Coordinates)
                (if (eq (vlax-get ename 'ObjectName) "AcDb2dPolyline")
                  T
                  nil
                )
              )
              v -1
            )
            (repeat (fix (vlax-curve-getEndParam ename))
              (setq l_blg1 (cons (vla-GetBulge ename (setq v (1+ v))) l_blg1))
            )
            (entdel (entlast))
            (cond
              ((not (vl-catch-all-error-p (vl-catch-all-apply 'vla-Offset (list vla_obj (- (* 0.5 e_width))))))
                (setq
                  ename (vlax-ename->vla-object (entlast))
                  l_pt
                  (append
                    l_pt
                    (reverse
                      (l-coor2l-pt
                        (vlax-get ename 'Coordinates)
                        (if (eq (vlax-get ename 'ObjectName) "AcDb2dPolyline")
                          T
                          nil
                        )
                      )
                    )
                  )
                  v -1
                )
                (repeat (fix (vlax-curve-getEndParam ename))
                  (setq l_blg2 (cons (vla-GetBulge ename (setq v (1+ v))) l_blg2))
                )
                (entdel (entlast))
                (setq
                  l_blg (append (reverse l_blg1) '(1.0) (mapcar '- l_blg2) '(1.0))
                  nw_pl (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar 'list (mapcar 'car l_pt) (mapcar 'cadr l_pt))))
                  v -1
                )
                (mapcar '(lambda (x) (vla-SetBulge nw_pl (setq v (1+ v)) x)) l_blg)
                (vla-put-Closed nw_pl 1)
                (vla-put-Normal nw_pl (vla-get-Normal vla_obj))
                (vla-put-Elevation nw_pl (vla-get-Elevation vla_obj))
                (vla-Update nw_pl)
                (setvar "cmdecho" 0)
                (command "_.revcloud" "_arc" (* (vla-get-Length nw_pl) 0.04) (* (vla-get-Length nw_pl) 0.04) "_object" (entlast) "_no")
                (setvar "cmdecho" 1)
              )
            )
          )
        )
      )
    )
  )
  (prin1)
)

 

[BIGAL]

Just some thoughts a closed pline use (vla-offset after checking is CW or CCW. Then revcloud (entlast).

 

A single line is 4 offset points extend ends then revcloud using those points.

 

An open pline again offset in & out, extend ends and join ends, join all segments, then revcloud (entlast) no need for complex bulge calcs. Hopefully no arcs at start or end.

 

Will have a go later.

 

[Monty Lisp]

Hi Tsuky and BIGAL, thank you for your replies! Much appreciated. The code is way to advanced for me to understand whats going on. It does seem to do what I want except for two things

• Somehow the arclength that is used as input is not used for the revcloud. Preferably it uses the default width (same as if you use the revcloud command without change the arclength)
• It only works on polylines, if it's possible it would be nice to also be able to select normal lines

Is it possible to use same routine as the normal 'REVCLOUD->select object' command when selecting an object but then make two copies of the selected line/polyline, and apply the revcloud->object command twice (first time selected 'No' for the reverse direction query, and the second time 'Yes'). So the algorithm would look something like

1. Enter command

2. Ask for object selection

3. Copy selected object in it's place

4. Use on the copied object 'revcloud' -> object -> reverse direction:yes

5. Copy original object again

6. Use on the 2nd copied object 'revcloud' -> object -> reverse direction:no

 

Thats my current workflow, hope this makes sense.

[pkenewell]

@Monty Lisp This could almost be done with a macro:

(defun C:PRC (/ e)
   (command "._undo" "_BE")
   (if (setq e (entsel "\nSelect an Object: "))
      (command "._copy" (car e) "" "0,0,0" "0,0,0" "._revcloud" "_o" "_l" "_y" "._copy" (car e) "" "0,0,0" "0,0,0" "._revcloud" "_o" "_l" "_n")
   )
   (command "._undo" "_E")
)

 

Edited May 8 by pkenewell

[Monty Lisp]

Thanks pkenewell, that seems to do the trick, also very understandable what happens. Only thing I don't understand is why start the command with the 'undo' -> 'begin' and at the end end with 'end'?

[pkenewell]

1 hour ago, Monty Lisp said:

Thanks pkenewell, that seems to do the trick, also very understandable what happens. Only thing I don't understand is why start the command with the 'undo' -> 'begin' and at the end end with 'end'?

@Monty Lisp The "UNDO" command creates a group of the following COPY and REVCLOUD commands. They will all act like 1 command if you need to UNDO, rather than pressing undo multiple times to get back to the drawing state before you started the lisp routine. Otherwise you would have to UNDO the REVCLOUD and COPY commands individually (total of four times) to get back to before you started the routine.

[BIGAL]

Need some more info like what size is revcloud spacing and layer to put it on. A pline with arcs on end is a bit of a challenge.

 

Give this a try

 
; https://www.cadtutor.net/forum/topic/84863-revcloud-around-polyline-object-on-both-sides-but-retain-polyline/

(defun doline ( / obj2 obj3 p1 p2 p3 p4 start end ang)

(vla-offset obj dist)
(setq ent2 (entlast))
(setq obj2 (vlax-ename->vla-object ent2 ))

(setq start (vlax-curve-getstartPoint obj2))
(setq end (vlax-curve-getEndPoint obj2))
(setq ang (angle start end))

(setq p1 (polar start (+ pi ang) dist))
(setq p2 (polar end ang dist))

(vlax-put obj2 'startpoint p1)
(vlax-put obj2 'endpoint p2)

(vla-offset obj (- dist))

(setq ent3 (entlast))
(setq obj3 (vlax-ename->vla-object ent3))

(setq start (vlax-curve-getstartPoint obj3))
(setq end (vlax-curve-getEndPoint obj3))
(setq ang (angle start end))
(setq p3 (polar start (+ pi ang) dist))
(setq p4 (polar end ang dist))

(vlax-put obj3 'startpoint p3)
(vlax-put obj3 'endpoint p4)

(command "line" p1 p3 "")
(setq ent4 (entlast))
(command "line" p2 p4 "")
(setq ent5 (entlast))

(command "pedit" ent2 "Y" "j" ent3 ent4 ent5 "" "")

(princ)
)

(defun dopoly ( / )
(setq obj (vlax-ename->vla-object ent))
(cond 
  ((= (vlax-get obj 'closed) -1)(dopoly2))
  ((= (vlax-get obj 'closed)  0)(dopoly3))
)
(princ)
)

(defun dopoly2 ( / a1 a2 )
(vla-offset obj dist)
(setq obj2 (vlax-ename->vla-object (entlast)))
(setq a1 (vlax-get obj 'area))
(setq a2 (vlax-get obj2 'area))
(if (> a2 a1)
  (princ)
  (progn
    (vla-delete obj2)
    (vla-offset obj (- dist))
    (command "pedit" (entlast) "R" "")
  )
)
(princ)
)
  
(defun dopoly3 ( / lst p1 p2 p3 p4 ent2 ent3 ent4)
(setq lst '())
(vla-offset obj dist)
(setq ent2 (entlast))

(setq co-ord1 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent2))))

(setq p1 (car co-ord1))
(setq p2 (cadr co-ord1))
(setq p4 (nth (- (length co-ord1) 1) co-ord1))
(setq p3 (nth (- (length co-ord1) 2) co-ord1))
(setq p1 (polar p1 (angle p2 p1) dist))
(setq p4 (polar p4 (angle p3 p4) dist))

(setq lst (cons (car p1) lst))
(setq lst (cons (cadr p1) lst))
(setq x 0)
(repeat (- (length co-ord1) 2)
  (setq lst (cons (car (nth (setq x (1+ x)) co-ord1)) lst))
  (setq lst (cons (cadr (nth x co-ord1)) lst))
)
(setq lst (cons (car p4) lst))
(setq lst (cons (cadr p4) lst))
(setq lst (reverse lst))

(vlax-put (vlax-ename->vla-object ent2) 'coordinates lst)

(setq lst '())

(vla-offset obj (- dist))
(setq ent3 (entlast))
(setq co-ord2 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent3))))

(setq p5 (car co-ord2) p6 (cadr co-ord2))
(setq p8 (nth (- (length co-ord2) 1) co-ord2))
(setq p7 (nth (- (length co-ord2) 2) co-ord2))
(setq p5 (polar p5 (angle p6 p5) dist))
(setq p8 (polar p8 (angle p7 p8) dist))

(setq lst (cons (car p5) lst))
(setq lst (cons (cadr p5) lst))
(setq x 0)
(repeat (- (length co-ord2) 2)
  (setq lst (cons (car (nth (setq x (1+ x)) co-ord2)) lst))
  (setq lst (cons (cadr (nth x co-ord2)) lst))
)
(setq lst (cons (car p8) lst))
(setq lst (cons (cadr p8) lst))
(setq lst (reverse lst))

(vlax-put (vlax-ename->vla-object ent3) 'coordinates lst)

(command "line" p5 p1 "")
(setq ent4 (entlast))
(command "line" p8 p4 "")
(setq ent5 (entlast))

(command "pedit" ent2 "J" ent3 ent4 ent5 "" "")
(princ)
)

(defun c:wow ( / ent ent2 ent3 ent4 dist obj objtype)
(setq ent (car (entsel "\nSelect a object ")))
(setq obj (vlax-ename->vla-object ent))

(setq dist (getreal "\nEnter offset "))

(setq objtype (vlax-get obj 'objectname))

(cond 
((= objtype "AcDbline")(doline))
((= objtype "AcDbPolyline")(dopoly))
)

(command "revcloud" "A" 10 10 "E" (entlast) "n")

(princ)
)
(c:wow)

 

 

Edited May 9 by BIGAL