Topic: Revision Cloud w/ ORTHO

[TomREd]

I have been searching for a revcloud routine that has the abitilty to be along a straight line. Does anyone have a modified lisp routine that accepts ORTHO ON/OFF.

I just dont like not having a straight cloud line in a schedule. Looks like poop to me if all "bumpy" so to say...

[David Hall]

what version of acad? in 06/07 the rev cloud in the draw menu will except a closed polyline, so you can draw a rectangle or closed polyline first, then convert to cloud.  Thats what I do.

[hudster]

Code: [Select]

*^C^Crectangle;\\revcloud;a;5;10;object;l;no;
here is a copy of the macro I use in 2007 which draws the rectangle, then converts to a revcloud, and repeats till cancelled.

Just change the arc size to suit.

[GDF]

Here is a box cloud routine...

Code: [Select]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;; Box Cloud Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun BXCLOUDIT (/ OS S1 D1 D2 D3 P1 P2 P3 P4 P5 PN PH)
  ;;(cond
  ;;((= cloud 0)(setvar "plinewid" 0))
  ;;((= cloud 1)(setvar "plinewid" 3))
  ;;)
  (setq OS (getvar "osmode"))
  ;;(alert (strcat "Box Cloud Placed on\nLayer : " (getvar "clayer")))
  (graphscr)
  (command "osmode" 0 "cmdecho" 0)
  (setq P1 (getpoint "\n* Pick the Lower Left Corner *")
P3 (getcorner P1 "\n* Pick the Upper Right Corner *")
PN (getint
     "\n* Enter number of Arcs along width of Rectangle <default=7> * "
   ) ;_ end of getint
P2 (list (car P3) (cadr P1))
P4 (list (car P1) (cadr P3))
D1 (- (distance P1 P2) (distance P2 P3))
  )
  (if (= PN nil)
    (setq PN 7)
  )
  (setq D3 (/ (distance P1 P2) PN))
  (setq PH (polar P1 (angle P1 P2) D3))
  ;;(command "pline" P1 "w" 0 0 "a" "a" "130" PH "")
  (command "pline" P1 "a" "a" "130" PH "")
  (setq S1 (entlast))
  (while (> (distance PH P2) (+ D3 1))
    (setq P5 PH)
    (setq PH (polar P5 (angle P1 P2) D3))
    (command "pline" P5 "a" "a" "130" PH "")
    (command "pedit" "l" "j" S1 "" "")
    (setq S1 (entlast))
  ) ;_ end of while
  (setq P5 PH)
  (setq PH (polar P2 (angle P2 P3) D3))
  (command "pline" P5 "a" "a" "180" PH "")
  (command "pedit" "l" "j" S1 "" "")
  (setq S1 (entlast))
  ;;Right side
  (while (> (distance PH P3) D3)
    (setq P5 PH)
    (setq PH (polar P5 (angle P2 P3) D3))
    (command "pline" P5 "a" "a" "130" PH "")
    (command "pedit" "l" "j" S1 "" "")
    (setq S1 (entlast))
  ) ;_ end of while
  (setq P5 PH)
  (setq PH (polar P3 (angle P3 P4) D3))
  (command "pline" P5 "a" "a" "180" PH "")
  (command "pedit" "l" "j" S1 "" "")
  (setq S1 (entlast))
  ;;Top side
  (while (> (distance P4 PH) D3)
    (setq P5 PH)
    (setq PH (polar P5 (angle P3 P4) D3))
    (command "pline" P5 "a" "a" "130" PH "")
    (command "pedit" "l" "j" S1 "" "")
    (setq S1 (entlast))
  ) ;_ end of while
  (setq P5 PH)
  (setq PH (polar P4 (angle P4 P1) D3))
  (command "pline" P5 "a" "a" "180" PH "")
  (command "pedit" "l" "j" S1 "" "")
  (setq S1 (entlast))
  ;;Left side
  (while (> (distance P1 PH) D3)
    (setq P5 PH)
    (setq PH (polar P5 (angle P4 P1) D3))
    (command "pline" P5 "a" "a" "130" PH "")
    (command "pedit" "l" "j" S1 "" "")
    (setq S1 (entlast))
  ) ;_ end of while
  (command "pline" PH "a" "a" "130" P1 "")
  (command "pedit" "l" "j" S1 "" "")
  (command "osmode" OS)
  (BULGELASTIT) ;;reverse bulge
  (princ)
)
;;;
(defun BULGELAST-IT (/ CNT COORDS DIV EOBJ)
  (setq EOBJ (vlax-ename->vla-object
       ;;(car (entsel "\n* Select pline: "))
               (entlast)
     )
  )
  (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)
)
(defun BULGELASTIT ()
  (initget "Y N")
  (if (= "Y" (getkword "\n* Reverse Cloud Bulge - Yes/No <No> *"))
    (BULGELAST-IT)
  )
  (princ)
)

Gary

[TomREd]

Im using what seems to be Ancient now but still very effective..ADT3.3

I found a lisp from CAB that looks like a superior LISP to what I'm using now..Express Tools REVCLOUD.LSP

I just couldn't find a link for the newest version of his updated lisp. I'm so glad to find a forum where I can actually get some answers. Thanks Guys