擷取圖層名稱的範例程式

  • Share this:

這是阿貴在網路上下載的 autolisp 程式,

那裡可以學到 autolisp, Visual Lisp, DCL, VBA,... 的程式設計,

是個不錯的學習網站.

下面是範例的內容:

; 以下是 AUTOLISP 的程式碼

(defun c:getlay (/ NAMES SIZ1) ; 下載網址 http://www.afralisp.net/autolisp/tutorials/files/lisp18.zip ; 此程式下載自 WWW.AFRALISP.NET ; 功能 : 取得圖檔內的圖層 LAYER 名稱, ; 選取圖層名稱後, 按 [ENTER] 鍵, ; 程式會顯示您所選取的圖層名稱. ; 這是擷取 DATABASE 資料的範例程式 ; 其對話框檔案為 getlay.dcl ; 以下為程式原始內容, 註解, 阿貴未更改, ; (setvar "cmdecho" 0) ;switch off command echo (setq siz1 "0") ;initiliase variable (setq userclick T) ;set flag

(setq f 1) ;rewind pointer

(while ;start while loop (setq t1 ( tblnext "Layer" f)) ;get the next layer (setq f nil) ;reset pointer (setq b ( cdr ( assoc 2 t1))) ;get the layer name (if (/= b "DEFPOINTS") ;if name is not equal to DEFPOINTS (setq NAMES ( append NAMES (list b))) ;Add the layer name to the list ) ;if ) ;while

(setq dcl_id (load_dialog "getlay.dcl")) ;load dialogue (if (not (new_dialog "getlay" dcl_id) ;check for errors ) ;not (exit) ;if problem exit ) ;if (set_tile "sel1" "0") ;initilise list box (start_list "sel1") ;start the list (mapcar 'add_list NAMES) ;add the layer names (end_list) ;end the list

(action_tile "cancel" "(done_dialog) (setq userclick nil)" ) ;action_tile ;if cancel set flag to nil

(action_tile "accept" (strcat "(progn (setq SIZ1 (get_tile \"sel1\"))" " (done_dialog)(setq userclick T))" ) ;strcat ) ;action tile ;if OK get the layer selected

(start_dialog) (unload_dialog dcl_id)

(if userclick ;if flag true (progn (setq SIZ1 (nth (atoi SIZ1) NAMES)) ;get the name of the layer from the list (alert (strcat "\nYou Selected Layer " SIZ1)) ;display the name ) ;end progn ) ;end if

(princ)

) ;defun C:getlay

(princ)

; 以上是 AUTOLISP 的程式碼

; 其中有顏色的文字行程式碼, 是在設計程式時的標準範例, 只需更改變數的名稱即可.

;

;

; 以下是 DCL 對話框的程式碼

getlay : dialog { //dialog name

label = "Get Layer" ; //give it a label

: popup_list { //define list box

key = "sel1"; //give it a name

value = "0"; //initial value

} //end list

ok_cancel ; //predifined OK/Cancel

} //end dialog

; 以上是 DCL 對話框的程式碼


Tags: