;; Draws revision clouds with optional bulge size, undo, hatching or revision delta.
;; Saved from: http://www.cadtutor.net/forum/showthread.php?13081-Updated-Drawing-Notification&highlight=revison+clouds
;; Slightly modified by Igal Averbuh 2018 (added Solid and Cross Hatch options for revision clouds)
(defun c:DWL ( / rev ins stpt obpt np dist ang distsf count hatch? bulgesf np1 vOAttdia fOError undocount lstpt cloud switcher)
(setq fOerror *error*)
(defun *error* (sErr)
(if (or (= sErr "Function cancelled")
(= sErr "quit / exit abort")
)
(princ)
(princ (strcat "\nError: " sErr))
)
(setq *error* fOError)
(princ)
)
(setvar "cmdecho" 0)
(if (equal 0.0 (getvar "dimscale") 0.00001)
(setvar "dimscale" 1)
)
(princ "\nNote: Clouds must go in a counter-clockwise direction")
(initget 1)
(setq stpt (getpoint "\nFrom Point: ")
lstpt stpt
np stpt
bulgesf 0.25 ; default bulge scale factor is "medium"
np1 ""
undocount 0
switcher 0)
(command "_.undo" "_begin")
(command "_.pline" stpt "_width" 0 0 "_arc")
(prompt "\n")
(while (and np (/= np1 stpt))
(while (not (listp np1))
(initget 0 "Small Medium Large eXtra Close Undo")
(setq np1 (getpoint lstpt "\nSmall/Medium/Large/eXtra-large/Close/Undo : "))
(if (not (listp np1))
(cond ; set scale factor for cloud bulges
((= np1 "Small")(setq bulgesf 0.25))
((= np1 "Medium")(setq bulgesf 0.5))
((= np1 "Large")(setq bulgesf 1.0))
((= np1 "eXtra")(setq bulgesf 2.0))
((= np1 "Close")(setq np stpt
np1 stpt))
((= np1 "Undo")
(if (< 0 undocount); can't backup beyond beginning...
(progn
(command "_undo")
(setq
lstpt (getvar "lastpoint")
undocount (1- undocount)
)
(if (= 0 undocount) (command "_arc"))
)
(princ "\nAll cloud segments already undone.")
)
)
)
(setq np np1)
)
)
(if (= np "")(setq np nil))
(if np
(setq dist (distance lstpt np)
ang (angle lstpt np))
(setq dist nil)
)
(if dist
(progn
(if (= dist (* 2 (* (getvar "dimscale") bulgesf)))
(progn
(setq distsf (fix (/ dist (* (getvar "dimscale") bulgesf))) count distsf)
(while (> count 0)
(setq np (polar lstpt ang (/ dist distsf)))
(command "s" (polar (polar lstpt ang (/ dist (* distsf 2)))
(if (zerop switcher)
(- ang (/ pi 2))
(+ ang (/ pi 2))
)
(/ dist (* distsf 4))) np)
(setq lstpt np
count (1- count)
undocount (1+ undocount)
switcher (abs (1- switcher)))
)
)
)
)
)
(if (/= np1 stpt)(setq np1 ""))
)
(command "")
(setq cloud (entlast))
(if (< 0 undocount)
(progn
(while (/= hatch? "None")
(initget 0 "Pline Offset Rev Solid Cross")
(setq hatch? (getkword "\nAditional Options [Pline/Offset/Rev delta/http://www.cadtutor.net/forum/showthread.php?13081-Updated-Drawing-Notification&highlight=revison+clouds] : "))
(cond
((= hatch? "Cross")(command "hatch" "ansi37,N" (* 1.0 (getvar "dimscale")) "0" "last" ""))
((= hatch? "Solid")(command "hatch" "solid,N" (* 1.0 (getvar "dimscale")) "45" "last" ""))
((= hatch? "Offset")(command "offset" (* 0.015 (getvar "dimscale")) cloud (getvar "limmax") "")(setq cloud (entlast)))
((= hatch? "Pline")(command ".pedit" cloud "w" "0.02" ""))
((= hatch? "Rev")
(setq rev (getstring "\n Revision Number? : "))
(if (= rev "")(setq rev "-"))
(setq ins (getpoint "\nPick delta insertion point: "))
(entmake (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")'(67 . 0)'(410 . "Model")
'(100 . "AcDbPolyline")'(90 . 2)'(70 . 1)'(43 . 0.0)'(38 . 0.0)'(39 . 0.0)
(cons 10 (polar ins (/ pi 2)(* 0.29 (getvar "dimscale"))))'(42 . 0.0)
(cons 10 (polar ins (* 7 (/ pi 6))(* 0.29 (getvar "dimscale"))))'(42 . 0.0)
(cons 10 (polar ins (* 11(/ pi 6))(* 0.29 (getvar "dimscale"))))'(42 . 0.0)
'(210 0.0 0.0 1.0)))
(entmake (list '(0 . "TEXT")'(100 . "AcDbEntity")'(67 . 0)'(410 . "Model")'(100 . "AcDbText")
(cons 10 (polar ins (/ pi 2) (* 0.012 (getvar "dimscale"))))
(cons 40 (* 0.125 (getvar "dimscale")))(cons 1 (strcase rev))'(50 . 0.0)
'(41 . 0.85)'(51 . 0.0)'(7 . "STANDARD")'(71 . 0)'(72 . 4)
(cons 11 (polar ins (/ pi 2) (* 0.012 (getvar "dimscale"))))
'(210 0.0 0.0 1.0)'(100 . "AcDbText")'(73 . 2)))
)
(t (setq hatch? "None"))
)
)
)
)
(command "_.undo" "_end")
(setq *error* fOError)
(princ)
)
(princ)
(c:dwl)

Advertisements