[编程交流] Objectdcl示例

(defun C:AreaSq (/ areaunits  ss      n         attlst
           lstpnt     inspnt      areametres areametresmm
           oldcmd     olddzi      oldlay     oldosm
           outent     rtosnum)
 (AreaSqdcl)
 (setq    OldDzi (getvar "DIMZIN");save all used sysvars
   OldCmd (getvar "CMDDIA")
 );setq
   
 (setvar "CMDECHO" 0);supress command prompts
 (if (= (logand (getvar "UNDOCTL") 4) 4);if UNDO-mode 'Auto', then
 (command "_.UNDO" "_GROUP");start UNDO-group
 );if
 (setvar "DIMZIN" (boole 4 8 OldDzi));set zero-supression
  (setvar "TOOLTIPS" 1)
 (setq DwgUnits (getvar "INSUNITS" )
       AreaUnits 0
           ss (ssget '((0 . "HATCH,CIRCLE,ELLIPSE,SPLINE,POLYLINE,LWPOLYLINE"))))
 (if   ss
 (progn
 (setq n (1- (sslength ss)))
 (while (>= n 0)
 (command "_.AREA" "_OBJECT" (ssname ss n))
 (setq AreaUnits (+ AreaUnits (getvar "AREA"))
       n (1- n))
 );while
 
 (if
 (= SquareUnit "squaremetres" )
 (progn
 (setq rtosNum (atoi  DeciPlaces )
       AreaMetres (rtos AreaUnits  2 RtosNum)
 );setq
   
 (alert(strcat"\n" "Area = " AreaMetres "m²"))
 );progn
 );if
 
 
 (if
 (= SquareUnit "squaremillimetres" )
 (progn
 (setq rtosNum (atoi  DeciPlaces )
       AreaMetresmm (rtos  (* AreaUnits 1000)  2 RtosNum)
 );setq
   
 (alert(strcat"\n" "Area = " AreaMetresmm "mm²"))
 );progn
 );if
 
 );progn
 (alert "\nNo Polylines selected!")
 );if
   
 (setvar "DIMZIN" OldDzi)
 (if (= (logand (getvar "UNDOCTL") 4) 4)
 (command "_.UNDO"
        "_END"
        "_.UNDO"
        "_MARK"
 );command
 );if
 (setvar "CMDECHO" OldCmd)
 (princ)
 );defun
 ;-------------
 ; DCL Function
 ;-------------
 (defun AreaSqdcl (/  ReturnValue SquareUnitTile)
 (defun CheckOnClose (/ )
 (cond
 ((not (setq SquareUnitTile (get_tile "SquareUnit")));if no buttons filled
 (mode_tile "SquareUnit" 2)
 )
 (T
 (setq
       SquareUnit   (substr SquareUnitTile 1)
   DeciPlaces   (nth (read (get_tile "DeciPlaces"))DeciPlacesList)
 );setq
 (done_dialog 1)
 );T
 );cond
 );defun CheckOnClose
 (if (> (setq DLGID (load_dialog "AreaSq.dcl")) 0)
 (progn
 (new_dialog "AreaSq" DLGID)
 (setq DeciPlacesList '("None" "1" "2" "3" ))
 (start_list "DeciPlaces")
 (mapcar 'add_list  DeciPlacesList)
 (end_list)
 (if (member DeciPlaces DeciPlacesList);see if the global variable is an available option in the list
 (set_tile "DeciPlaces" (rtos (vl-position DeciPlaces DeciPlacesList) 2 0));if it is, set it as default
 (set_tile "DeciPlaces" "1");if not, set the default to item 2 in list)
 );if
 (action_tile "DeciPlaces" "(ErrorDLG 0)")
 (action_tile "accept" "(CheckOnClose)")
 (action_tile "cancel" "(exit)")
 (setq ReturnValue(start_dialog))
 (unload_dialog DLGID)
 );progn
 (not (princ "\nNo DCL"))
 );if
 ReturnValue
 );defun AreaSqdcl
 (defun ErrorDLG (pErr)
 (cond
 ((= pErr 0) (set_tile "error" ""))
 );cond
 );defun
 
 

dcl_settings : default_dcl_settings { audit_level = 3 ; }
AreaSq : dialog {
  key = "Display" ;
  label = "Area of an entity" ;
  :boxed_radio_row   {
  fixed_width = true ;
  key = "SquareUnit";
  :radio_button {
  label =  "Square metres                    " ;
  key = "squaremetres" ;
  value = "1";
  }
  :radio_button {
  label =  "Square millimetres   " ;
  key = "squaremillimetres" ;
  }
  }//End radio row
  :boxed_column {
  width = 1 ;
  :popup_list {
  label = "Number of Decimal Places                          ";
  key = "DeciPlaces" ;
  }//popup list
     }//boxed column
  errtile ;
  ok_cancel ;
  }//dialog