Revision Cloud lisp

Topics relating to AutoLisp and SDS.

Moderators: CMS Inc, avaernes

Post Reply
greekpatriot
Newbie
Posts: 2
Joined: Thu Feb 09, 2006 12:01 am

Revision Cloud lisp

Post by greekpatriot » Thu Feb 09, 2006 1:44 am

|;

(defun input_integer (a b / c)
(setq a (strcat a " <"(rtos b 2 0)"> "))
(setq c (getint a))
(if (/= c NIL)
(setq b c)
(setq b b)
)
)
(setq incr 1)

(defun item (ent)
(cdr(car(entget(ent))))
)

(defun ERR (s)
(if (/= s "Function cancelled\n")
(if (= s "quit / exit abort")
(princ)
(alert (strcat " >> Error << \n"))
)
)
(setvar "CLAYER" CL)
(setq *error* olderr)
(princ)
)

(Defun C:REVCLOUD (/
ARC_DIST ;;radius of included arc
INC_ANGLE ;;included angle in degrees
LAST_PT ;;the last point just entered/shown
START_PT ;;where the cloud began
NEXT_PT ;;where we are going next
TMP ;;tempory holder for radius of bulge
)
(setq olderr *error* *error* err)
(setq ce (getvar "cmdecho"))
(setq blp (getvar "blipmode"))
(setq osm (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setvar "osmode" 0)
(setq cl (getvar"clayer"))
(if (not (tblsearch "LAYER" "rcloud"))
(command "layer" "m" "rcloud" "c" "12" "rcloud" "")
)
(command "layer" "s" "rcloud" "")

;;--------real program starts here!

(Setq INC_ANGLE 110)

(if (and
(/= "" (getcfg "AppData/AC_Bonus/Revcld_Bulge"))
(/= nil (getcfg "AppData/AC_Bonus/Revcld_Bulge"))
)
(setq ARC_DIST (atof (getcfg "AppData/AC_Bonus/Revcld_Bulge")))
(if (= (getvar "DIMSCALE") 0)
(setq ARC_DIST 0.375)
(setq ARC_DIST (* 0.375 (getvar "DIMSCALE")))
)
);end if

(prompt (strcat "\nArc length set at " (rtos ARC_DIST 2 3)))
(setq plwid (getvar"plinewid"))
(setvar "plinewid" (* (getvar"dimscale")0.0078)); use for wider than zero pline width
; (setvar"plinewid" 0.0); use for zero pline width
(setq om (getvar"orthomode"))
(setvar "orthomode" 0)
(initget "Arc")
(setq LAST_PT (GetPoint "\nArc length/<Pick cloud starting point>: "))

(if (= LAST_PT "Arc")
(progn
(initget 6)
(setq TMP (getdist (strcat "\nArc length <" (rtos ARC_DIST 2 3) ">: ")))
(if TMP
(Progn
(setq ARC_DIST TMP)
;R14 method of saving variable values
(setcfg "AppData/AC_Bonus/Revcld_Bulge" (rtos ARC_DIST))
)
)
(setq LAST_PT (getpoint "\nPick cloud start point: "))
) ;;end STR "RADIUS" test
)

(if LAST_PT (progn ;;start up the cloud generator...
(setq START_PT LAST_PT
SAVED_EN (entlast))
(Prompt "\nGuide crosshairs along cloud path...")
(Command
"_.pline" ;draw cloud as a polyline on current layer
LAST_PT
"_a" ;specify arc option
"_a" ;specify angle option
INC_ANGLE ;included angle
)
)) ;end IF LAST_PT

(While LAST_PT ;;as long as we have a last point value,

(Setq NEXT_PT (GrRead 1) ;;real time read
READTYP (car NEXT_PT)
)
(if (or (= 5 READTYP) (= READTYP 3)) ;;read a position or a pick?
(progn
(setq NEXT_PT (cadr NEXT_PT))
(If (or (> (Distance LAST_PT NEXT_PT) ARC_DIST) (= READTYP 3))
(Progn
(Command NEXT_PT "_a" INC_ANGLE)
(Setq LAST_PT NEXT_PT)
)
)
(If (>
(Distance LAST_PT NEXT_PT)
(Distance START_PT NEXT_PT)
)
(Progn
(Command START_PT "_cl")
(Setq LAST_PT Nil)
(prompt "\nCloud finished.")
)
)
)
(prompt "\nMove the pointer to draw the cloud")
);End if
);End while
(setvar "cmdecho" ce)
(setvar "blipmode" blp)
(setvar "osmode" osm)
(setvar "orthomode" om)
(setvar "plinewid" plwid)
(clnu)
(setq *error* olderr)
(Princ)
) ;end cloud.lsp

(defun clnu (/ num pt)
(setq incr (input_integer "\nEnter revision number: " incr))
(setq pt(getpoint"\nPlace revision number on cloud: "))
(command"layer""s""rcloud""")
(command "polygon" "3" pt "I" (/(getvar"dimscale")6.5))
(setvar"cecolor""7")
(command "text" "m" pt (*(getvar"dimscale")(getvar"dimtxt")1.0) "0" (itoa incr))
(setq incr (+ incr 1))
(setvar"cecolor""bylayer")
(command"layer""s"cl"")
)

(Defun c:RCHELP (/)
(prompt " The Revision Cloud program draws a user specified bulge pline\n")
(prompt " along the path of the crosshairs. To close the cloud, \n")
(prompt " simply return to the starting point\n")
(prompt " The cloud arc length can be specified in the beginning, with keyboard input\n")
(prompt " by specifying A for Arc, entering a length, or picking two pts.\n")
(textscr)
(princ)
)

(Prompt " REVCLOUD loaded. Type REVCLOUD to draw Revision Cloud,\n")
(prompt " to close, return to starting point. For additional Help - RCHELP")
(Princ)
Post Reply