|
;;; PL2Cloud.lsp by Charles Alan Butler
;;; Copyright 2005
;;; by Precision Drafting & Design All Rights Reserved.
;;; Contact at  ab2draft@TampaBay.rr.com
;;;
;;; Version 1.0 Beta May 1,2004
;;; Version 1.1 Beta May 5,2004
;;; Added options to size the arc
;;; Version 1.2 Beta May 19,2004
;;; Added option for cloud style
;;; Version 1.3 Beta June 15,2004
;;; Revised to use Dialog Box Interface
;;; Version 1.4 Beta June 23,2004
;;; Dialog Box Revisions
;;; Version 1.5 Beta September 16,2004
;;; Incorperated the Dialog File Creator Routine
;;; Disabled the Chord Length DimScale feature
;;; Version 2.0 October 22,2004
;;; Support for arcs polylines and will also process a picked
;;; spline, circle or ellipse
;;; Version 2.0 October 27,2004
;;; Pline width bug, preset width set to 0 for user draw.
;;; Version 2.1 February 23,2005
;;; Added multiple pick of new cloud, bug fix - remember chord length
;;; Version 2.2 February 24,2005
;;; Added support for rotated UCS
;;; Version 2.3 October 27,2005
;;; Added Layer Selection for cloud
;;; Version 2.4 April 04,2006
;;; Added Help & option to use pline layer, plus clean up of code
;;;
;;; DESCRIPTION
;;; User picks or Draws a LW polyline and the routine draws a revision
;;; cloud along it, User option to delete the original polyline
;;; No UCS supported, Only World
;;;
;;; Files Required to be in the ACAD search path
;;; pl2cloud.dcl ; note- created by this lisp
;;; rc_normal.sld ; slides are found in the zip file
;;; rc_shadow.sld
;;; rc_length.sld
;;;
;;; Limitations
;;; No error checking when object pline is too small
;;;
;;;
;;; Command Line Usage
;;; Command: PL2Cloud
;;; Dialog Box is displayed unless there is a problem
;;; Then the command line version is as follows
;;; Enter method to get polyline. [Pick / Draw / Options / Shadow] < ick>:
;;; Keep the original polyline [Yes No] <No>:y
;;; Pick Polyline to cloud:
;;;
;;; Options: Command Line Version
;;; Pick - allows user to pick an existing poly line
;;; Draw - allows user to draw a new polyline
;;; Shadow - toggles the shadow effect on/off
;;; Options - Change Arc Angle, makes arcs fatter or thinner
;;; Change the chord length of the arcs
;;; Enter a new Chord length or negative number to divide into DimScale
;;; Enter the actual chord length desired or
;;; enter a negative number and that number will be divided into
;;; the current dimscale to derive the chord length
;;;
;;; This software is provided "as is" without express or implied ;
;;; warranty. All implied warranties of fitness for any particular ;
;;; purpose and of merchantability are hereby disclaimed. ;
;;; You are hereby granted permission to use, copy and modify this ;
;;; software without charge, provided you do so exclusively for ;
;;; your own use or for use by others in your organization in the ;
;;; performance of their normal duties, and provided further that ;
;;; the above copyright notice appears in all copies and both that ;
;;; copyright notice and the limited warranty and restricted rights ;
;;; notice appear in all supporting documentation. ;
(prompt "Loading PL2Cloud....")
(defun c:pl2cloud (/ dscale plw dist spcs
usercmd useros *error* a270 a90
userbm oer oldplw ent entlst
oldent method keeppl useds arcang
chord cloud_style draw_style
keeppl cur_lay PlineLay cur_lay_old
)
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun *error* (msg)
(if
(not
(member
msg
'("console break" "Function cancelled" "quit / exit abort" "")
)
)
(princ (strcat "\nError: " msg))
) ; if
(setvar "Plinewid" oldplw)
(setvar "blipmode" userbm) ;reset blipmode
(setvar "CMDECHO" usercmd)
(setvar "osmode" useros)
(setq pl2cloudglobal (put_saved_vars)
userbm nil
oldplw nil
usercmd nil
useros nil
)
(princ)
) ;end error function
;;; =================================================================
;;; Main Routine
;;; =================================================================
(setq usercmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq useros (getvar "osmode"))
(setvar "osmode" 0)
(setq userbm (getvar "blipmode"))
(setvar "blipmode" 0)
(setq oldplw (getvar "plinewid"))
(setq cur_lay (getvar "clayer")
cur_lay_old cur_lay)
;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;; Arc size is determined by the following defaults
;; They remain set throught the session in one drawing
;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;; arcang 140 arc angle, smaller = flatter arcs ; start with 140
;; chord -2 Arc Chord Length > 0 use actual chord distance
;; else < 0 use dim scale / (abs chord)
;; example dimscale = 48 use -1 and chord will be 48 units
;; use -2 and chord will be 24 units
;; cloud_style "Normal" or "Shadow" Pre set cloud style
(if (not pl2cloudglobal)
;; does not exist yet, make global so we can reuse in this drawing
;; these are the default values used the first time run in a session
(setq pl2cloudglobal ; Set Default values
(list 140 ; Model Space ArcAng
140 ; Paper Space ArcAng
-2 ; Model Space Chord
0.5 ; Paper Space Chord
"Pick" ; draw style Pick or Draw
nil ; Keep poly line T or nil
nil ; Use pline layer
"Normal"); cloud style Normal or Shadow
)
)
(get_saved_vars)
;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;; To Place on layer cloud, color red (1)
;; remove the ;; from the next line
;;(command ".layer" "m" "cloud" "c" "1" "cloud" "")
;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(setq dscale (getvar "dimscale")
plw 0 ;(* 0.05 dscale); polyline width
a90 (/ pi 2)
a270 (* pi 1.5)
2pi (* pi 2)
useds chord ; use dimscale flag
)
(setq arcdata (arc_check))
(if (null(and (create_dcl "pl2cloud.dcl")
(run_dialog)))
(run_command_line))
;; keep flag in case dimscale is changed
(if useds (setq chord useds))
(*error* "")
(gc)
(princ)
) ;End program
(prompt "\nEnter PL2Cloud to run.")
(princ)
;;;ず癭昂,父,喊`昂ず癭昂,父,喊`昂ず癭昂,父,喊`昂,父,;
;;; End of main routine
;;;ず癭昂,父,喊`昂ず癭昂,父,喊`昂ず癭昂,父,喊`昂,父,;
;;; -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=-
;;; -
;;; Functions -
;;; -
;;; -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=-
;;-----------------------------------------------------------------
;; Dialog Box - get ready to start the dialog for the first time
;;-----------------------------------------------------------------
(defun run_dialog ()
(setq dcl_id (load_dialog "pl2cloud.dcl"))
(if (new_dialog "pl2cloud" dcl_id)
(progn
(while (= (setq dialog_action (dialog_call)) 2)
(initget 6)
(if (setq
tmp (getdist
(strcat "\nSpecify arc length <" (rtos chord) ">: ")
)
)
(setq chord tmp useds tmp)
)
(new_dialog "pl2cloud" dcl_id)
)
(if (= dialog_action 1) ; make the cloud
(progn
(setvar "clayer" cur_lay)
(if (= draw_style "Pick")
(do_pick_method)
(do_draw_method)
)
(setvar "clayer" cur_lay_old)
)
)
(unload_dialog dcl_id)
T
)
(alert "Clould not load pl2cloud.dcl.")
)
) ; defun run_dialog
;;======================================================
;; Dialog Box - Tiles Set Up
;;======================================================
(defun dialog_call (/ rtnval)
(defun remove_| (lst / x)
(vl-remove-if
(function
(lambda (x) (wcmatch x "*|*"))
)
lst
)
)
;; Load Layer Names <--------------<<<
(setq lay_list (list (cdr (assoc 2 (tblnext "LAYER" 1)))))
(while (setq tmp (tblnext "LAYER"))
(setq lay_list (append lay_list (list (cdr (assoc 2 tmp)))))
)
(setq lay_list (remove_| lay_list))
(if (> (length lay_list) 1)
(setq lay_list (acad_strlsort lay_list))
)
;; *********************************
;; load values need for layer box
;; *********************************
(start_list "lay_list")
(mapcar 'add_list lay_list)
(end_list)
(if (setq n (vl-position cur_lay lay_list))
(set_tile "lay_list" (itoa n))
(set_tile "lay_list" "0")
)
(action_tile "lay_list" "(SETQ cur_lay (NTH (ATOI $value) lay_list))")
;;**********************************
(set_style (if (= cloud_style "Normal") "rbNormal" "rbShadow"))
(setq x (dimx_tile "rc_lng_img")
y (dimy_tile "rc_lng_img")
)
(start_image "rc_lng_img")
(slide_image 0 0 x y "rc_length")
(end_image)
(set_tile "edtLength" (rtos chord))
(if (in_paper_space)
(set_tile "TitleMd" "You are in Paper Space, PS values loaded.")
(set_tile "TitleMd" "You are in Model Space, MS values loaded.")
)
(action_tile "rbNormal" "(set_style $key)")
(action_tile "rbShadow" "(set_style $key)")
(action_tile "rc_img" "(set_style $key)")
(action_tile "edtLength" "(get_arc_length $value)")
(action_tile "radPick" "(get_values)")
(action_tile "radDraw" "(get_values)")
(action_tile "btnPick" "(done_dialog 2)")
(set_tile "PlineLay" (if plinelay "1" "0"))
(set_pick draw_style)
(if keeppl
(set_tile "KeepPl" "1")
(set_tile "KeepPl" "0")
)
(action_tile "accept" "(Get_Values)(done_dialog 1)")
(action_tile "help" "(cloud_help)")
(setq rtnval (start_dialog))
rtnval
) ; defun dialog_call
;;======================================================
;; Dialog Box - get vars & exit dialog
;;======================================================
(defun get_values ()
(setq keeppl (= (get_tile "KeepPl") "1"))
(setq PlineLay (= (get_tile "PlineLay") "1"))
(if (= (get_tile "radPick") "1")
(progn
(setq draw_style "Pick")
(mode_tile "KeepPl" 0)
(mode_tile "PlineLay" 0)
)
(progn
(setq draw_style "Draw")
(mode_tile "KeepPl" 1)
(mode_tile "PlineLay" 1)
)
)
) ; defun get_values
;;======================================================
;; Dialog Box - Pline Entry Method Buttons
;;======================================================
(defun set_pick (key)
(if (= key "Pick")
(progn
(set_tile "radPick" "1")
(set_tile "radDraw" "0")
)
(progn
(set_tile "radPick" "0")
(set_tile "radDraw" "1")
)
)
) ; defun set_pick
;;======================================================
;; Dialog Box - error check user entered length
;;======================================================
(defun get_arc_length (len / newlen)
(setq len (strcase len)
newlen (distof len)
useds nil ; turn off the DimScale Feature
)
(cond
((or (= len "") (<= newlen 0.0))
(set_tile "error" "Arc length must positive and nonzero.")
)
(t
(set_tile "error" "")
(setq chord (distof len))
(set_tile "edtLength" (rtos chord))
)
) ;cond
) ;defun get_arc_length
;;======================================================
;; Dialog Box - Style Buttons
;;======================================================
(defun set_style (key / x y active)
(setq x (dimx_tile "rc_img")
y (dimy_tile "rc_img")
)
(cond
((= key "rbNormal")
(setq active "rc_normal"
cloud_style "Normal"
)
(set_tile "rbNormal" "1")
)
((= key "rbShadow")
(setq active "rc_shadow"
cloud_style "Shadow"
)
(set_tile "rbShadow" "1")
)
(t ; this is the toggle from image select
(if (= (get_tile "rbNormal") "1")
(progn
(setq active "rc_shadow"
cloud_style "Shadow"
)
(set_tile "rbShadow" "1")
)
(progn
(setq active "rc_normal"
cloud_style "Normal"
)
(set_tile "rbNormal" "1")
)
)
)
)
(start_image "rc_img")
(fill_image 0 0 x y 0)
(slide_image 0 0 x y active)
(end_image)
) ; defun set_style
;;--------------------------------------------------------------------
;; H E L P message for dialog box.
;;--------------------------------------------------------------------
(defun cloud_help ()
(alert
(strcat
"Pl2Cloud.lsp (c) 2006 Charles Alan Butler\n"
"This LISP routine will allow you to add a polyline cloud by two methods.\n"
"You may select an existing LWpline, circle, ellipse, or spline for the cloud to be\n"
"traced around. You have the option to keep the selected object. Or you may \n"
"draw the pline real time and the cloud will be traced along it. The pline will be\n"
"removed. If you select an object to be traced you then have drawn the option\n"
"to use the current layer or the layer of the selected object.\n"
"Selecting the cloud image in the dialog box will toggle the cloud style.\n"
"\n"
"Please report any problems you may have.\n"
)
)
) ;end defun help
;;--------------------------------------------------------------------
;;==================================================================
;; this code is used if there is a problem with the dialog box code
;;==================================================================
(defun run_command_line ()
;; Get type of polyline input
(prompt "\nDraw Revision Cloud from poly line.")
(while (null method)
(initget "Pick Draw Options Shadow")
(setq method
(getkword
(strcat
"\nEnter method to get polyline. "
"[Pick / Draw / Options / Shadow] (ArcAng="
arcdata
") <ick>:"
)
)
)
(cond
((= method "Options") ; set arc angle, chord length, Pline width
(get_options)
(setq arcdata (arc_check))
(setq method nil) ; stay in loop
)
((= method "Shadow")
(if (= cloud_style "Normal")
(setq cloud_style "Shadow")
(setq cloud_style "Normal")
)
(prompt (strcat "Cloud Style changed to " cloud_style))
(setq method nil) ; stay in loop
)
((null method) (setq method "Pick")) ; nil default to pick
) ; end cond stmt
) ; end while
(initget "Yes No")
(setq keeppl (getkword "\nKeep the original polyline [Yes No] <No>:"))
(if (null keeppl)
(setq keeppl "No")
)
(cond
((= method "Pick") (do_pick_method))
((= method "Draw") (do_draw_method))
) ; end cond stmt
) ; end defun run_command_line
;;==================================================================
;;======================================================
;; Allow user to pick a pline
;;======================================================
(defun do_pick_method (/ ent entlst lay)
(while (setq ent (entsel "\nPick Polyline to trace cloud: "))
(if
(member (cdr (assoc 0 (setq entlst (entget (car ent)))))
'("LWPOLYLINE" "SPLINE" "CIRCLE" "ELLIPSE"))
(progn
(if PlineLay
(setq lay (cdr (assoc 8 entlst)))
)
(makecloud entlst lay)
(if (or (= keeppl "No") (= keeppl nil))
(entdel (car ent))
)
)
(prompt "\nError - Not a LWpolyline.")
)
) ; end while
(if (null ent)
(prompt "\n*** Missed - Press ENTER to start again. ***")
)
) ; end defun do_pick_method
;;======================================================
;; Allow user to draw a pline
;;======================================================
(defun do_draw_method (/ oldent ent)
(prompt
"\nDraw the polyline, C to Close pline or Enter when done."
)
(setq oldent (entlast))
(setvar "Plinewid" 0)
(command "_.pline")
;; repeat a point input until Enter
(while (> (getvar "CMDACTIVE") 0)
(command pause)
)
(setq ent (entlast))
(if (null (eq ent oldent))
(makecloud (entget ent) nil)
)
(if (or (= keeppl "No") (= keeppl nil))
(entdel ent)
)
) ; end defun do_draw_method
;;======================================================
;; get variables stored in list
;;======================================================
(defun get_saved_vars ()
(if (in_paper_space); get paperspace vars
(setq arcang (nth 1 pl2cloudglobal)
chord (nth 3 pl2cloudglobal)
)
;; else get model space vars
(setq arcang (nth 0 pl2cloudglobal)
chord (nth 2 pl2cloudglobal)
)
)
;; get other user preferences
(setq draw_style (nth 4 pl2cloudglobal)
keeppl (nth 5 pl2cloudglobal)
PlineLay (nth 6 pl2cloudglobal)
cloud_style (nth 7 pl2cloudglobal))
); defun get_saved_vars
;;======================================================
;; save variables in a global variable list
;;======================================================
(defun put_saved_vars ()
(if (in_paper_space); save paperspace vars
(setq pl2cloudglobal
(list
(nth 0 pl2cloudglobal)
(abs arcang)
(nth 2 pl2cloudglobal)
chord
draw_style
keeppl
PlineLay
cloud_style
)
)
;; else save model space vars
(setq pl2cloudglobal
(list
(abs arcang)
(nth 1 pl2cloudglobal)
chord
(nth 3 pl2cloudglobal)
draw_style
keeppl
PlineLay
cloud_style
)
)
)
); defun put_saved_vars
;;==================================================================
;; Test Title Mode returns T when in PS & Viewports are closed
;;==================================================================
(defun in_paper_space ()
(and (= (getvar "tilemode") 0) ;In PS
(= (getvar "cvport") 1) ; Vps Closed
)
); defun in_paper_space
;;======================================================
;; routine to make the actual polyline cloud
;;======================================================
(defun makecloud (elst lay / pvl len closed loop pt1 p1 p2 ang
divDist endParam totLen dist ulay)
;;-----------------------------------------------------------------
;; <<< get points along an object >>>
;;-----------------------------------------------------------------
;; n is the number of intervals
;; e is the entity name
;; returns a list of points
(vl-load-com)
(setq dist 0.0)
(setq obj (cdr (assoc -1 elst))
endParam (vlax-curve-getEndParam obj)
totLen (vlax-curve-getDistAtParam obj endParam)
)
;; set arc distance and number of arc in segment
;; Arc chord length set to aprox
(setq spcs (/ totlen chord)) ; Arc spacing
(setq spcs (fix (+ 0.999 spcs))) ; round up
(setq spcs (max 2 spcs)) ; min of 2 spaces
(setq divDist (/ totlen spcs)) ; set arc distances
;; use this if UCS is rotated
;;(setq p1 (trans p1 0 1)) ; WCS to UCS
(while (<= dist totLen)
(setq pvl (cons (trans (vlax-curve-getPointAtDist obj dist) 0 1) pvl)
dist (+ dist divDist)
)
)
(setq pvl (reverse (cons
(trans (vlax-curve-getPointAtParam obj endParam) 0 1) pvl)))
(if (= (@polydir pvl) "CW")
(setq arcang (- arcang))
)
(and
lay
(setq ulay (getvar "clayer"))
(setvar "clayer" lay)
)
;; start polyline command with width and arc mode
(command "._PLINE" (car pvl) "W" plw "" "_A")
(foreach pt pvl ;draw side segments
(if (= cloud_style "Shadow")
(command "_w" "0" (* chord 0.10))
)
(command "_A" arcang pt)
)
;;----------------------------------------------------
(if closed
(command "CL")
(command "")
)
(and
lay
(setvar "clayer" ulay)
)
) ; end defun makecloud
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;; Get Cloud Arc Options
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;; used by command line version
(defun get_options (/ loop newang newcd)
(prompt "\nOptions to set Arc Angle and Chord Length.")
;; get arc angle -----------------------------------
(setq loop t)
(while loop
(initget 6)
(setq newang
(getint
(strcat "\nEnter a new Arc Angle (90 to 175 deg) <"
(itoa arcang)
"> :"
)
)
)
(cond
((null newang) ; leave angle as is
(setq loop nil)
)
((or (< newang 90) (> newang 175))
(alert "\nAngle out of range. Enter between 90 and 175")
)
((setq arcang newang) ; set new angle
(setq loop nil)
)
)
) ; end while
;; get chord length ------------------------------
(setq loop t)
(while loop
(initget 2)
(setq newcd
(getreal
(strcat "\nEnter a new Chord length or negative "
"number to divide into DimScale <"
(rtos chord 2 2)
"> :"
)
)
)
(cond
((null newcd) ; leave as is
(setq loop nil)
)
((or (< newcd -5) (> newcd 500))
(alert "\nAngle out of range. Enter between -5 and 500")
)
((setq chord newcd) ; set new angle
(if (< chord 0)
(setq useds chord) ; save flag
(setq useds nil) ; clear flag
)
(setq loop nil)
)
)
) ; end while
;; get pline width ------------------------------
) ; end defun get_options
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;; Check Arc Data
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun arc_check ()
;; error check arc data
(if (= (type arcang) "REAL")
(setq arcang (fix arcang))
)
(setq arcang (max 90 (min 175 arcang))) ; 90 <= ArcAng <= 175
(setq chord (if (= chord 0) -2 chord)) ; trap 0 only
(if (< chord 0)
;; arc chord length set to (/ dist (dimscale / chord))
(setq useds chord ; save flag
chord (/ dscale (abs chord))
)
;; ELSE
(setq useds nil) ; clear flag
)
(strcat (rtos arcang 2 0) " Length=" (rtos chord 2 2))
) ; end defun arc_check
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;; Return the direction of a lwpline
;; Modified form of
;; PolyDir.LSP v1.0 (03-05-02) John F. Uhden, Cadlantic
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun @polydir (coords / i p1 p2 p3 sum)
(setq i 1
sum 0.0
)
(repeat (- (length coords) 2)
(setq p1 (nth (1- i) coords)
p2 (nth i coords)
i (1+ i)
p3 (nth i coords)
sum (+ sum (@delta (angle p1 p2) (angle p2 p3)))
)
)
(if (minusp sum) "CW" "CCW")
) ; end defun
;;-----------------------------------------------------------------------
;; This function returns the deflection angle (in radians) of two angles:
;;-----------------------------------------------------------------------
(defun @delta (a1 a2)
(cond
((> a1 (+ a2 pi)) (setq a2 (+ a2 2pi)))
((> a2 (+ a1 pi)) (setq a1 (+ a1 2pi)))
)
(- a2 a1)
) ; end defun
;; ***************************************************
;; create_dcl function to create a dcl support
;; file if it does not exist
;; Usage : (create_dcl "file name")
;; Returns : T if successful else nil
;; ***************************************************
(defun create_dcl (fname / acadfn dcl-rev-check)
;;=======================================
;; check revision date Routine
;;=======================================
(defun dcl-rev-check (fn / rvdate ln lp)
;; revision flag must match exactly and must
;; begin with //
(setq rvflag "// Revision Control 04/04/2006@10:01" )
(if (setq fn (findfile fn))
(progn ; check rev date
(setq lp 5) ; read 4 lines
(setq fn (open fn "r")) ; open file for reading
(while (> (setq lp (1- lp)) 0)
(setq ln (read-line fn)) ; get a line from file
(if (vl-string-search rvflag ln)
(setq lp 0)
)
)
(close fn) ; close the open file handle
(if (= lp -1)
nil ; no new dcl needed
t ; flag to create new file
)
)
t ; flag to create new file
)
)
(if (null(wcmatch (strcase fname) "*`.DCL"))
(setq fname (strcat fname ".DCL"))
)
(if (dcl-rev-check fname)
;; create dcl file in same directory as ACAD.PAT
(progn
(setq acadfn (findfile "ACAD.PAT")
fn (strcat (substr acadfn 1 (- (strlen acadfn) 8))fname)
fn (open fn "w"),
)
(foreach x (list
"// WARNING file will be recreated if you change the next line"
rvflag
"//PL2cloud.dcl"
"//"
""
"pl2cloud : dialog {"
" label = \"PL2Cloud - Revision Cloud Options Rev 2.4 - By CAB\" ;"
" spacer_1 ;"
" : text { key = \"t1\"; label = \"From a picked or drawn ployline create a Revision Cloud.\";}"
" : text { key = \"TitleMd\" ;}"
" spacer_1 ;"
""
" : boxed_row { label = \"Arc Style\" ;"
" : image_button { key = \"rc_img\" ; color = 0 ; aspect_ratio = 0.8 ; fixed_width = true ; width = 11 ;}"
" : radio_column {"
" spacer_0 ;"
" : radio_button { key = \"rbNormal\" ; label = \"Normal\" ; mnemonic = \"N\" ;}"
" : radio_button { key = \"rbShadow\" ; label = \"Shadow\" ; mnemonic = \"S\" ;}"
" spacer_0 ;"
" }"
" spacer_1 ;"
" }"
" spacer_1 ;"
" : boxed_row { label = \"Arc Chord Length\" ;"
" : image { key = \"rc_lng_img\" ; aspect_ratio = 0.8 ; color = 0 ; fixed_width = true ; width = 11 ;}"
" : column {"
" : edit_box { key = \"edtLength\" ;label = \"Chord Length\" ; fixed_width = true ; edit_width = 6 ;}"
" : button { key = \"btnPick\" ; fixed_width = true ; label = \"Pick <\" ; width = 4 ;}"
" }"
" }"
" "
" spacer_1 ;"
" : boxed_row { label = \"Create Options\" ;"
" : radio_column {"
" spacer_0 ;"
" : radio_button { key = \"radPick\" ; label = \"Pick Existing Pline\" ; mnemonic = \"P\" ;}"
" spacer_1 ;"
" : radio_button { key = \"radDraw\" ; label = \"Draw a New Pline\" ; mnemonic = \"D\" ;}"
" spacer_0 ;"
" }"
" : column {"
" : row {"
" : toggle { key = \"KeepPl\"; label = \"Keep PolyLine\";} "
" : toggle { key = \"PlineLay\"; label = \"PLine Layer\";}"
" }"
" : boxed_row {label = \"< Current Layer >\";"
" :popup_list{ key = \"lay_list\"; width = 30; height = 1;}"
" }"
" }"
""
" }"
" spacer_1 ;"
" ok_cancel_help ;"
"}"
) ; endlist
(princ x fn)
(write-line "" fn)
) ; end foreach
(close fn)
(setq acadfn nil)
(alert (strcat "\nDCL file created, please restart the routine"
"\n again if an error occures."))
t ; return True, file created
)
t ; return True, file found
)
) ; end defun
;;;***********************************
;;; -=< End Of File >=-
;;;*********************************** | 
发表于 2006-10-31 18:31:00
置顶卡
变色卡
显身卡
发表于 2006-10-31 22:10:00
楼主