Here is a simple revision cloud program
The original question was could you turn an existing polyline into a cloud.
(cloudx2 (car (entsel)))) will do that with loading the routines below.
The there might be a problem with the direction of the bulges. The bulge routine below changes their orientation.
Peter Jamtgaard
Code:
(defun C:Cloud (/ entSelection)
(vl-load-com)
(princ "\nDraw polyline clockwise around area: ")
(vl-cmdf "pline")
(setq entSelection (entlast))
(while (= (getvar "cmdactive") 1)
(vl-cmdf pause)
)
(if (/= entSelection (entlast))(cloudx2 (entlast)))
)
(defun Cloudx2 (entSelection / objSelection
sngIncrement
sngLength
sngPosition
ssSelections)
(if debug (princ "\nCloudx2 "))
(setq objSelection (vlax-ename->vla-object entSelection)
)
(vla-put-closed objSelection :vlax-true)
(initget 6)
(if (not (setq sngDist (getdist "\nEnter relative arc diameter ")))
(setq sngDist 0.125)
)
(setq sngLength (vlax-curve-getDistAtParam objSelection
(vlax-curve-getEndParam objSelection)
)
sngPosition 0
sngIncrement (* (getvar "dimscale")
sngDist
)
)
(setvar "cmdecho" 0)
(while (< sngPosition (- sngLength sngIncrement))
(vl-cmdf "arc")
(vl-cmdf (vlax-curve-getPointAtDist objSelection sngPosition))
(setq sngPosition (+ sngPosition sngIncrement))
(vl-cmdf "E")
(vl-cmdf (vlax-curve-getPointAtDist objSelection sngPosition))
(vl-cmdf "Angle" 180)
(if ssSelections
(setq ssSelections (ssAdd (entlast) ssSelections))
(setq ssSelections (ssAdd (entlast)))
)
)
(vl-cmdf "arc")
(vl-cmdf (vlax-curve-getPointAtDist objSelection sngPosition))
(vl-cmdf "E")
(vl-cmdf (vlax-curve-getPointAtDist objSelection 0))
(vl-cmdf "Angle" 180)
(vl-cmdf "pedit" (entlast) "y" "j" ssSelections "" "")
(entdel entSelection)
)
(defun C:BULGE (/ CNT COORDS DIV EOBJ )
(setq EOBJ (vlax-ename->vla-object (car (entsel "Select pline: "))))
(if EOBJ
(progn
(setq COORDS (vlax-safearray->list
(vlax-variant-value
(vla-get-coordinates EOBJ)
)
)
)
(setq CNT 0)
(if (or (= (vla-get-objectname EOBJ) "AcDb2dPolyline")
(= (vla-get-objectname EOBJ) "AcDb3dPolyline")
)
(setq DIV 3)
(setq DIV 2)
)
(while (< CNT (/ (length COORDS) DIV))
(if (< (vla-getbulge EOBJ CNT) 0.0)
(vla-setbulge EOBJ CNT 1.0)
(vla-setbulge EOBJ CNT -1.0)
)
(setq CNT (1+ CNT))
)
)
)
(prin1)
)