87 lines
22 KiB
Common Lisp
Executable File
87 lines
22 KiB
Common Lisp
Executable File
(defun $SetLayer(layers / alist)
|
|
(foreach alist layers (if (null (tblsearch "LAYER" (car alist))) (COMMAND ".LAYER" "N" (car alist) "S" (car alist) "C" (cadr alist) (car alist) "")) (COMMAND ".LAYER" "S" (car alist) "C" (cadr alist) (car alist) "") ))
|
|
|
|
(defun $BpRotate( BasePt AnyPt RtAngle / ConvX ConvY RotatePt ) (if (/= RtAngle 0.0) (setq RtAngle (* (/ RtAngle 180.0) pi)) ) (setq ConvX (+ (car BasePt) (- (* (- (car AnyPt) (car BasePt)) (cos RtAngle)) (* (- (cadr AnyPt) (cadr BasePt)) (sin RtAngle)))) ConvY (+ (cadr BasePt) (+ (* (- (car AnyPt) (car BasePt)) (sin RtAngle)) (* (- (cadr AnyPt) (cadr BasePt)) (cos RtAngle)))) ) (setq RotatePt (list ConvX ConvY)) RotatePt)
|
|
|
|
(defun $ChkReal(InCha Range / ) (cond ((= Range ">") (if (and (distof InCha 2) (> (distof InCha 2) 0.0)) InCha nil )) ((= Range ">=") (if (and (distof InCha 2) (>= (distof InCha 2) 0.0)) InCha nil )) ((= Range "<=") (if (and (distof InCha 2) (<= (distof InCha 2) 0.0)) InCha nil )) ((= Range "<") (if (and (distof InCha 2) (< (distof InCha 2) 0.0)) InCha nil )) ((= Range "All") (if (distof InCha 2) InCha nil )) (T nil) ))
|
|
|
|
(defun $ChkInt(InCha Range / ) (cond ((= Range ">") (if (and (distof InCha 2) (null (wcmatch InCha "*.*")) (> (distof InCha 2) 0.0)) InCha nil)) ((= Range ">=") (if (and (distof InCha 2) (null (wcmatch InCha "*.*")) (>= (distof InCha 2) 0.0)) InCha nil)) ((= Range "<=") (if (and (distof InCha 2) (null (wcmatch InCha "*.*")) (<= (distof InCha 2) 0.0)) InCha nil)) ((= Range "<") (if (and (distof InCha 2) (null (wcmatch InCha "*.*")) (< (distof InCha 2) 0.0)) InCha nil)) ((= Range "All") (if (and (distof InCha 2) (null (wcmatch InCha "*.*"))) InCha nil)) (T nil) ))
|
|
|
|
(defun $ChkLayerName( InCha / ) (if (or (= (strlen InCha) 0) (wcmatch InCha (strcat "*[] `#`@`?`*`~`[`,`'!%^&()+={}|`\\:" (chr 32) (chr 59) "\"<>/]*")) ) nil InCha))
|
|
|
|
(setq #LockChk T)
|
|
|
|
(defun $AddStLists( / StLists) (setq StLists (list "Straight Pipe " "Flange " "Elbow 90 " "Elbow 45 " "Elbow 22+1/2 " "Elbow 11+1/4 " "Elbow 5+5/8 " "Tee " "Reducer " "Bell Mouth " "Flanged Tee " "Gate Valve (A) " "Gate Valve (B) " "Y branch " ) ) (start_list "MkStList" 3) (mapcar 'add_list StLists) (end_list))
|
|
|
|
(defun $AddDuLists( / DuLists) (setq DuLists (list "Straight Pipe " "Flanged Spigot " "Collar " "Socket " "Flange " "Flanged Socket " "Flanged Bell Mouth " "Bend Socket 90 (A)" "Bend Socket 45 (A)" "Bend Socket 22+1/2 (A)" "Bend Socket 11+1/4 (A)" "Bend Flanged 90 (A)" "Bend Flanged 45 (A)" "Tee Socket (A)" "Tee Flanged (A)" "Tee Socket Flanged (A)" "X Socket (A)" "X Socket Flanged (A)" "Level Invert Tee (A)" "U Branch (A)" "Y Branch (A)" "Taper Socket (A)" "Taper Flanged (A)" "By-Pass (A)" "Bend Socket 90 (B)" "Bend Socket 45 (B)" "Bend Socket 22+1/2 (B)" "Bend Socket 11+1/4 (B)" "Bend Flanged 90 (B)" "Bend Flanged 45 (B)" "Tee Socket (B)" "Tee Flanged (B)" "Tee Socket Flanged (B)" "X Socket (B)" "X Socket Flanged (B)" "Level Invert Tee (B)" "U Branch (B)" "Y Branch (B)" "Taper Socket (B)" "Taper Flanged (B)" "By-Pass (B)" "Y Branch (C)" "Taper Socket (C)" "Taper Flanged (C)" "By-Pass (C)" "By-Pass Standard (D)" "By-Pass Short (D)" ) ) (start_list "MkDuList" 3) (mapcar 'add_list DuLists) (end_list))
|
|
|
|
(defun $AddSymLists( / SymLists) (setq SymLists (list "Gate Valve " "Butterfly Valve " "Check Valve " ) ) (start_list "MkSymList" 3) (mapcar 'add_list SymLists) (end_list))
|
|
|
|
(defun $InitSetValue( / Dcl_id Next )
|
|
(setq Next 5)
|
|
(if (> (setq Dcl_id (load_dialog "drpipe.dcl")) 0)
|
|
(while (< 1 Next)
|
|
(progn (if (new_dialog "MainDlg" Dcl_id)
|
|
(progn
|
|
($AddStLists)
|
|
($AddDuLists)
|
|
($AddSymLists)
|
|
($ShowLogo)
|
|
($SetDefaultValue)
|
|
(action_tile "MkUnitmm" "(setq #Unit \"mm\" )")
|
|
(action_tile "MkUnitcm" "(setq #Unit \"cm\" )")
|
|
(action_tile "MkUnitm" "(setq #Unit \"m\" )")
|
|
(action_tile "MkNameDia" "(setq #DrMethod \"Name\" )")
|
|
(action_tile "MkInDia" "(setq #DrMethod \"InDia\" )")
|
|
(action_tile "MkOutDia" "(setq #DrMethod \"OutDia\")")
|
|
(action_tile "MkScale" (strcat "(setq #Scale ($ChkValueAction $value " "\"Real\"" "\">\"" "\"*error : Scale (Real > 0.0)\"" "))"))
|
|
(action_tile "MkRotate" (strcat "(setq #Rotate ($ChkValueAction $value " "\"Real\"" "\"All\"" "\"*error : Rotate (Only real)\"" "))"))
|
|
(action_tile "MkPipeLayer" (strcat "(setq #PipeLayer ($ChkValueAction $value " "\"Layer\"" "\"nil\"" "\"*error : Pipeline Layer name\"" "))"))
|
|
(action_tile "MkCenLayer" (strcat "(setq #CenLayer ($ChkValueAction $value " "\"Layer\"" "\"nil\"" "\"*error : Centerline Layer name\"" "))"))
|
|
(action_tile "MkPipeCoNo" (strcat "(setq #PipeCoNo ($ChkValueAction $value " "\"Color\"" "\"MkPipeCoImage\"" "\"*error : Pipeline Color Number (255 >= Color >= 0)\"" "))"))
|
|
(action_tile "MkCenCoNo" (strcat "(setq #CenCoNo ($ChkValueAction $value " "\"Color\"" "\"MkCenCoImage\"" "\"*error : Centerline Color Number (255 >= Color >= 0)\"" "))")) (action_tile "MkStChk" (strcat "($ShowPipeTiles \"Steel\" \"InitNil\"" "(atoi (get_tile \"MkStList\")))"))
|
|
(action_tile "MkDuChk" (strcat "($ShowPipeTiles \"Ductile\" \"InitNil\"" "(atoi (get_tile \"MkDuList\")))"))
|
|
(action_tile "MkSymChk" (strcat "($ShowPipeTiles \"Symbol\" \"InitNil\"" "(atoi (get_tile \"MkSymList\")))"))
|
|
(action_tile "MkStList" (strcat "($ShowPipeTiles \"Steel\" \"InitNil\"" "(atoi (get_tile \"MkStList\")))"))
|
|
(action_tile "MkDuList" (strcat "($ShowPipeTiles \"Ductile\" \"InitNil\"" "(atoi (get_tile \"MkDuList\")))"))
|
|
(action_tile "MkSymList" (strcat "($ShowPipeTiles \"Symbol\" \"InitNil\"" "(atoi (get_tile \"MkSymList\")))"))
|
|
(action_tile "MkMainDia" "($ChkDiaValues $value \"Main\")")
|
|
(action_tile "MkSubDia" "($ChkDiaValues $value \"Sub\" )")
|
|
(action_tile "MkLength" (strcat "(setq #PipeLen ($ChkValueAction $value " "\"Real\"" "\">\"" "\"*error : Length value (Real > 0.0)\"" "))"))
|
|
(action_tile "accept" "($CheckAccept)")
|
|
(action_tile "cancel" "(done_dialog 0) (setq #OkJob nil)" )
|
|
(setq Next (start_dialog))
|
|
)
|
|
(progn (prompt "Unable to display dialog box") (unload_dialog Dcl_id) ) ) (unload_dialog Dcl_id) )
|
|
)
|
|
(progn (prompt "Unable to open dialog box") )
|
|
)
|
|
)
|
|
|
|
(defun $SetDefaultValue() (if #Unit (cond ((= #Unit "mm") (set_tile "MkUnitmm" "1")) ((= #Unit "cm") (set_tile "MkUnitcm" "1")) (T (set_tile "MkUnitm" "1")) ) (progn (setq #Unit "mm") (set_tile "MkUnitmm" "1") ) ) (if (and #Scale (numberp #Scale)) (set_tile "MkScale" (rtos #Scale 2 3)) (progn (setq #Scale 1.0) (set_tile "MkScale" "1.0") ) ) (if (and #Rotate (numberp #Rotate)) (set_tile "MkRotate" (rtos #Rotate 2 2)) (progn (setq #Rotate 0.0) (set_tile "MkRotate" "0.0") ) ) (if (and #PipeCoNo (= (type #PipeCoNo) 'INT)) (progn (set_tile "MkPipeCoNo" (itoa #PipeCoNo)) ($ShowCoImage "MkPipeCoImage" #PipeCoNo) ) (progn (setq #PipeCoNo 6) (set_tile "MkPipeCoNo" "6") ($ShowCoImage "MkPipeCoImage" #PipeCoNo) ) ) (if (and #CenCoNo (= (type #CenCoNo) 'INT)) (progn (set_tile "MkCenCoNo" (itoa #CenCoNo)) ($ShowCoImage "MkCenCoImage" #CenCoNo) ) (progn (setq #CenCoNo 3) (set_tile "MkCenCoNo" "3") ($ShowCoImage "MkCenCoImage" #CenCoNo) ) ) (if (and #PipeLayer (= (type #PipeLayer) 'STR)) (set_tile "MkPipeLayer" #PipeLayer) (progn (setq #PipeLayer "PipeLine") (set_tile "MkPipeLayer" #PipeLayer) ) ) (if (and #CenLayer (= (type #CenLayer) 'STR)) (set_tile "MkCenLayer" #CenLayer) (progn (setq #CenLayer "CenterLine") (set_tile "MkCenLayer" #CenLayer) ) ) (if #PipeType (cond ((and #ListNo (= #PipeType "Steel")) ($ShowPipeTiles #PipeType "InitDsp" #ListNo)) ((and #ListNo (= #PipeType "Ductile")) ($ShowPipeTiles #PipeType "InitDsp" #ListNo)) ((and #ListNo (= #PipeType "Symbol")) ($ShowPipeTiles #PipeType "InitDsp" #ListNo)) ( T (setq #PipeType "Steel" #ListNo 0) ($ShowPipeTiles #PipeType "InitNil" #ListNo)) ) (progn (setq #PipeType "Steel" #ListNo 0) ($ShowPipeTiles #PipeType "InitNil" #ListNo) ) ) (if #DrMethod (cond ((= #DrMethod "InDia") (set_tile "MkInDia" "1")) ((= #DrMethod "OutDia") (set_tile "MkOutDia" "1")) (T (set_tile "MkNameDia" "1")) ) (progn (setq #DrMethod "Name") (set_tile "MkNameDia" "1") ) ))
|
|
|
|
(defun $ChkValueAction(pValue pType pRange pMsg / ColorNo ) (cond ((= pType "Real") (if ($ChkReal pValue pRange) (progn (set_tile "error" "") (atof pValue)) (progn (set_tile "error" pMsg) nil) ) ) ((= pType "Int") (if ($ChkInt pValue pRange) (progn (set_tile "error" "") (atoi pValue)) (progn (set_tile "error" pMsg) nil) ) ) ((= pType "Layer") (if ($ChkLayerName $value) (progn (set_tile "error" "") pValue) (progn (set_tile "error" pMsg) nil) ) ) ((= pType "Color") (setq ColorNo ($ChkInt pValue ">=")) (if (and ColorNo (< (atoi ColorNo) 256)) (progn (set_tile "error" "") ($ShowCoImage pRange (atoi ColorNo)) (atoi ColorNo) ) (progn (set_tile "error" pMsg) nil) ) ) (T nil) ))
|
|
|
|
(defun $ChkDiaValues (InDia BoxName / PipeData ) (cond ((and (= BoxName "Main") InDia (= (type InDia) 'STR)) (if ($ChkInt InDia ">") (if ($ChkDataList (atoi InDia) nil nil) (progn (setq #MainDia (atoi InDia)) (set_tile "error" "")) (set_tile "error" "* Error : Not found Main data value") ) ) ) ((and (= BoxName "Sub") InDia (= (type InDia) 'STR)) (if ($ChkInt InDia ">") (if ($ChkDataList nil (atoi InDia) nil) (progn (setq #SubDia (atoi InDia)) (set_tile "error" "")) (set_tile "error" "* Error : Not found Sub data value") ) ) ) ))
|
|
|
|
(defun $ChkPipeTiles( PipeType ListNo / TileData index StKeyList DuKeyList SymKeyList ) (setq StKeyList (list (list 0 5 "stpipe(st00)" "st00prg.src") (list 1 1 "stpipe(st01)" "st01prg.src") (list 2 1 "stpipe(st02)" "st02prg.src") (list 3 1 "stpipe(st03)" "st03prg.src") (list 4 1 "stpipe(st04)" "st04prg.src") (list 5 1 "stpipe(st05)" "st05prg.src") (list 6 1 "stpipe(st06)" "st06prg.src") (list 7 4 "stpipe(st07)" "st07prg.src") (list 8 4 "stpipe(st08)" "st08prg.src") (list 9 1 "stpipe(st09)" "st09prg.src") (list 10 4 "stpipe(st10)" "st10prg.src") (list 11 4 "stpipe(st11)" "st11prg.src") (list 12 4 "stpipe(st12)" "st12prg.src") (list 13 4 "stpipe(st13)" "st13prg.src") ) ) (setq DuKeyList (list (list 0 5 "dupipe(du00)" "du00prg.src") (list 1 1 "dupipe(du01)" "du01prg.src") (list 2 1 "dupipe(du02)" "du02prg.src") (list 3 1 "dupipe(du03)" "du03prg.src") (list 4 1 "dupipe(du04)" "du04prg.src") (list 5 1 "dupipe(du05)" "du05prg.src") (list 6 1 "dupipe(du06)" "du06prg.src") (list 7 1 "dupipe(du07)" "du07prg.src") (list 8 1 "dupipe(du08)" "du08prg.src") (list 9 1 "dupipe(du09)" "du09prg.src") (list 10 1 "dupipe(du10)" "du10prg.src") (list 11 1 "dupipe(du11)" "du11prg.src") (list 12 1 "dupipe(du12)" "du12prg.src") (list 13 4 "dupipe(du13)" "du13prg.src") (list 14 4 "dupipe(du14)" "du14prg.src") (list 15 4 "dupipe(du15)" "du15prg.src") (list 16 4 "dupipe(du16)" "du16prg.src") (list 17 4 "dupipe(du17)" "du17prg.src") (list 18 4 "dupipe(du18)" "du18prg.src") (list 19 1 "dupipe(du19)" "du19prg.src") (list 20 4 "dupipe(du20)" "du20prg.src") (list 21 4 "dupipe(du21)" "du21prg.src") (list 22 4 "dupipe(du22)" "du22prg.src") (list 23 4 "dupipe(du23)" "du23prg.src") (list 24 1 "dupipe(du24)" "du24prg.src") (list 25 1 "dupipe(du25)" "du25prg.src") (list 26 1 "dupipe(du26)" "du26prg.src") (list 27 1 "dupipe(du27)" "du27prg.src") (list 28 1 "dupipe(du28)" "du28prg.src") (list 29 1 "dupipe(du29)" "du29prg.src") (list 30 4 "dupipe(du30)" "du30prg.src") (list 31 4 "dupipe(du31)" "du31prg.src") (list 32 4 "dupipe(du32)" "du32prg.src") (list 33 4 "dupipe(du33)" "du33prg.src") (list 34 4 "dupipe(du34)" "du34prg.src") (list 35 4 "dupipe(du35)" "du35prg.src") (list 36 1 "dupipe(du36)" "du36prg.src") (list 37 4 "dupipe(du37)" "du37prg.src") (list 38 4 "dupipe(du38)" "du38prg.src") (list 39 4 "dupipe(du39)" "du39prg.src") (list 40 4 "dupipe(du40)" "du40prg.src") (list 41 4 "dupipe(du41)" "du41prg.src") (list 42 4 "dupipe(du42)" "du42prg.src") (list 43 4 "dupipe(du43)" "du43prg.src") (list 44 4 "dupipe(du44)" "du44prg.src") (list 45 4 "dupipe(du45)" "du45prg.src") (list 46 4 "dupipe(du46)" "du46prg.src") ) ) (setq SymKeyList (list (list 0 5 "sympipe(sym00)" "sym00prg.src") (list 1 5 "sympipe(sym01)" "sym01prg.src") (list 2 5 "sympipe(sym02)" "sym02prg.src") ) ) (setq index 0) (cond ((= PipeType "Steel") (repeat (length StKeyList) (if (= (car (nth index StKeyList)) ListNo) (setq TileData (nth index StKeyList)) ) (setq index (1+ index)) ) ) ((= PipeType "Ductile") (repeat (length DuKeyList) (if (= (car (nth index DuKeyList)) ListNo) (setq TileData (nth index DuKeyList)) ) (setq index (1+ index)) ) ) ((= PipeType "Symbol") (repeat (length SymKeyList) (if (= (car (nth index SymKeyList)) ListNo) (setq TileData (nth index SymKeyList)) ) (setq index (1+ index)) ) ) (T (setq TileData (nth 0 StKeyList)) ) ) TileData)
|
|
|
|
(defun $ShowPipeTiles( PipeType InitType ListNo / ChkData EditKey ImageName FileName )(setq #PipeType PipeType #ListNo ListNo)(if (null (= (type ListNo) 'INT)) (set_tile "error" "* Error : Not Selected Pipe *") (progn (if (= InitType "InitNil") (progn (setq #MainDia nil #SubDia nil #PipeLen nil)) ) (cond ((= PipeType "Steel") (set_tile "MkStChk" "1") (set_tile "MkDuChk" "0") (set_tile "MkSymChk" "0") (set_tile "MkStList" (itoa ListNo)) (mode_tile "MkStList" 0) (mode_tile "MkDuList" 1) (mode_tile "MkSymList" 1) ) ((= PipeType "Ductile") (set_tile "MkStChk" "0") (set_tile "MkDuChk" "1") (set_tile "MkSymChk" "0") (set_tile "MkDuList" (itoa ListNo)) (mode_tile "MkStList" 1) (mode_tile "MkDuList" 0) (mode_tile "MkSymList" 1) ) (T (set_tile "MkStChk" "0") (set_tile "MkDuChk" "0") (set_tile "MkSymChk" "1") (set_tile "MkSymList" (itoa ListNo)) (mode_tile "MkStList" 1) (mode_tile "MkDuList" 1) (mode_tile "MkSymList" 0) ) ) (setq ChkData ($ChkPipeTiles PipeType ListNo)) (setq EditKey (nth 1 ChkData) ImageName (nth 2 ChkData) FileName (nth 3 ChkData) ) ($ShowPipeImage "MkPipeImage" ImageName) ($SetEditBox EditKey) (if (findfile FileName) (progn (set_tile "error" "") (load FileName) ) (set_tile "error" (strcat "* Not found filename : " FileName)) ) )))
|
|
|
|
(defun $SetEditBox( EditKey / ) (cond ((= EditKey 1) (if (and #MainDia (= (type #MainDia) 'INT)) (set_tile "MkMainDia" (itoa #MainDia)) (progn (setq #MainDia nil) (set_tile "MkMainDia" "") ) ) (set_tile "MkSubDia" "") (set_tile "MkLength" "") (mode_tile "MkMainDia" 0) (mode_tile "MkSubDia" 1) (mode_tile "MkLength" 1) ) ((= EditKey 2) (if (and #SubDia (= (type #SubDia) 'INT)) (set_tile "MkSubDia" (itoa #SubDia)) (progn (setq #SubDia nil) (set_tile "MkSubDia" "") ) ) (set_tile "MkMainDia" "") (set_tile "MkLength" "") (mode_tile "MkMainDia" 1) (mode_tile "MkSubDia" 0) (mode_tile "MkLength" 1) ) ((= EditKey 3) (if (and #PipeLen (= (type #PipeLen) 'REAL)) (set_tile "MkLength" (rtos #PipeLen 2 3)) (progn (setq #Lenght nil) (set_tile "MkLength" "") ) ) (set_tile "MkMainDia" "") (set_tile "MkSubDia" "") (mode_tile "MkMainDia" 1) (mode_tile "MkSubDia" 1) (mode_tile "MkLength" 0) ) ((= EditKey 4) (if (and #MainDia (= (type #MainDia) 'INT) #SubDia (= (type #SubDia) 'INT)) (progn (set_tile "MkMainDia" (itoa #MainDia)) (set_tile "MkSubDia" (itoa #SubDia)) ) (progn (setq #MainDia nil #SubDia nil ) (set_tile "MkMainDia" "") (set_tile "MkSubDia" "") ) ) (set_tile "MkLength" "") (mode_tile "MkMainDia" 0) (mode_tile "MkSubDia" 0) (mode_tile "MkLength" 1) ) ((= EditKey 5) (if (and #MainDia (= (type #MainDia) 'INT) #PipeLen (= (type #PipeLen) 'REAL)) (progn (set_tile "MkMainDia" (itoa #MainDia)) (set_tile "MkLength" (rtos #PipeLen 2 3)) ) (progn (setq #MainDia nil #PipeLen nil) (set_tile "MkMainDia" "") (set_tile "MkLength" "") ) ) (set_tile "MkSubDia" "") (mode_tile "MkMainDia" 0) (mode_tile "MkSubDia" 1) (mode_tile "MkLength" 0) ) ((= EditKey 6) (if (and #SubDia (= (type #SubDia) 'INT) #PipeLen (= (type #PipeLen) 'REAL)) (progn (set_tile "MkSubDia" (itoa #SubDia)) (set_tile "MkLength" (rtos #PipeLen 2 3)) ) (progn (setq #SubDia nil #PipeLen nil) (set_tile "MkSubDia" "") (set_tile "MkLength" "") ) ) (set_tile "MkMainDia" "") (mode_tile "MkMainDia" 1) (mode_tile "MkSubDia" 0) (mode_tile "MkLength" 0) ) ((= EditKey 7) (if (and #MainDia (= (type #MainDia) 'INT) #SubDia (= (type #SubDia) 'INT) #PipeLen (= (type #PipeLen) 'REAL)) (progn (set_tile "MkMainDia" (itoa #MainDia)) (set_tile "MkSubDia" (itoa #SubDia)) (set_tile "MkLength" (rtos #PipeLen 2 3)) ) (progn (setq #MainDia nil #SubDia nil #PipeLen nil) (set_tile "MkMainDia" "") (set_tile "MkSubDia" "") (set_tile "MkLength" "") ) ) (mode_tile "MkMainDia" 0) (mode_tile "MkSubDia" 0) (mode_tile "MkLength" 0) ) ( T (setq #MainDia nil #SubDia nil #PipeLen nil) (set_tile "MkMainDia" "") (set_tile "MkSubDia" "") (set_tile "MkLength" "") (mode_tile "MkMainDia" 1) (mode_tile "MkSubDia" 1) (mode_tile "MkLength" 1) ) ))
|
|
|
|
(defun $ShowPipeImage( KeyName SlideName / x y ) (setq x (dimx_tile KeyName) y (dimy_tile KeyName)) (start_image KeyName) (fill_image 0 0 x y 0) (slide_image 0 0 x y SlideName) (end_image))
|
|
|
|
(defun $ShowLogo() (start_image "MkLogo") (slide_image 0 0 (dimx_tile "MkLogo") (dimy_tile "MkLogo") "saman(samlogo)") (end_image))
|
|
|
|
(defun $ShowCoImage( KeyName ColorNo / x y ) (setq x (dimx_tile KeyName) y (dimy_tile KeyName)) (start_image KeyName) (fill_image 0 0 x y ColorNo) (end_image))
|
|
|
|
(defun $CheckAccept( / Scale Rotate PipeCoNo CenCoNo EditKey MainDia SubDia PipeLen ) (if (= (get_tile "MkUnitmm") "1") (setq #Unit "mm")) (if (= (get_tile "MkUnitcm") "1") (setq #Unit "cm")) (if (= (get_tile "MkUnitm") "1") (setq #Unit "m" )) (if (= (get_tile "MkNameDia") "1") (setq #DrMethod "Name" )) (if (= (get_tile "MkInDia") "1") (setq #DrMethod "InDia" )) (if (= (get_tile "MkOutDia") "1") (setq #DrMethod "OutDia")) (setq Scale ($ChkReal (get_tile "MkScale") ">")) (setq Rotate ($ChkReal (get_tile "MkRotate") "All")) (setq PipeCoNo ($ChkInt (get_tile "MkPipeCoNo") ">=")) (setq CenCoNo ($ChkInt (get_tile "MkCenCoNo") ">=")) (setq MainDia ($ChkInt (get_tile "MkMainDia") ">")) (setq SubDia ($ChkInt (get_tile "MkSubDia") ">")) (setq PipeLen ($ChkReal (get_tile "MkLength") ">")) (setq #PipeLayer ($ChkLayerName (get_tile "MkPipeLayer"))) (setq #CenLayer ($ChkLayerName (get_tile "MkCenLayer"))) (setq EditKey (nth 1 ($ChkPipeTiles #PipeType #ListNo))) (if (and Scale Rotate PipeCoNo CenCoNo #PipeLayer #CenLayer EditKey ) (progn (set_tile "error" "") (setq #Scale (atof Scale) #Rotate (atof Rotate) #PipeCoNo (atoi PipeCoNo) #CenCoNo (atoi CenCoNo) ) (cond ((= EditKey 1) (if (and MainDia ($ChkDataList (atoi MainDia) nil nil)) (progn (setq #MainDia (atoi MainDia) #SubDia nil #PipeLen nil ) (done_dialog 1) (setq #OkJob T) ) (set_tile "error" "*Error : Invalid Main Diameter") ) ) ((= EditKey 4) (if (and MainDia SubDia ($ChkDataList (atoi MainDia) (atoi SubDia) nil)) (progn (setq #MainDia (atoi MainDia) #SubDia (atoi SubDia) #PipeLen nil ) (done_dialog 1) (setq #OkJob T) ) (set_tile "error" "*Error : Invalid Main or Sub Diameter") ) ) ((= EditKey 5) (if (and MainDia PipeLen ($ChkDataList (atoi MainDia) nil (atof PipeLen))) (progn (setq #MainDia (atoi MainDia) #PipeLen (atof PipeLen)) (done_dialog 1) (setq #OkJob T) ) (set_tile "error" "No Key in Main Diameter or Length") ) ) ) ) (progn (set_tile "error" "No Key any value") (setq #OkJob nil) ) ))
|
|
|
|
(defun $InitPutValue( / FilePt ) (if (setq FilePt (open "DrPipe.set" "w")) (progn (princ "\n... Saving Working Condition Setting to 'DrPipe.set' ...") (princ (strcat (chr 59) "*\n" (chr 59) "* DrPipe Initial Setting file 'DrPipe.set' \n" (chr 59) "*\n" ) FilePt) (if (and #Unit (= (type #Unit) 'STR)) (princ (strcat "(setq #Unit \"" #Unit "\")\n") FilePt) ) (if (and #DrMethod (= (type #DrMethod) 'STR)) (princ (strcat "(setq #DrMethod \"" #DrMethod "\")\n") FilePt) ) (if (and #Scale (numberp #Scale)) (princ (strcat "(setq #Scale " (rtos #Scale 2 4) ")\n") FilePt) ) (if (and #Rotate (numberp #Rotate)) (princ (strcat "(setq #Rotate " (rtos #Rotate 2 4) ")\n") FilePt) ) (if (and #PipeLayer (= (type #PipeLayer) 'STR)) (princ (strcat "(setq #PipeLayer \"" #PipeLayer "\")\n") FilePt) ) (if (and #CenLayer (= (type #CenLayer) 'STR)) (princ (strcat "(setq #CenLayer \"" #CenLayer "\")\n") FilePt) ) (if (and #PipeCoNo (numberp #PipeCoNo)) (princ (strcat "(setq #PipeCoNo " (itoa #PipeCoNo) ")\n") FilePt) ) (if (and #CenCoNo (numberp #CenCoNo)) (princ (strcat "(setq #CenCoNo " (itoa #CenCoNo) ")\n") FilePt) ) (if (and #PipeType (= (type #PipeType) 'STR)) (princ (strcat "(setq #PipeType \"" #PipeType "\")\n") FilePt) ) (if (and #ListNo (numberp #ListNo)) (princ (strcat "(setq #ListNo " (itoa #ListNo) ")\n") FilePt) ) (if (and #MainDia (numberp #MainDia)) (princ (strcat "(setq #MainDia " (itoa #MainDia) ")\n") FilePt) ) (if (and #SubDia (numberp #SubDia)) (princ (strcat "(setq #SubDia " (itoa #SubDia) ")\n") FilePt) ) (if (and #PipeLen (numberp #PipeLen)) (princ (strcat "(setq #PipeLen " (rtos #PipeLen 2 4) ")\n") FilePt) ) (close FilePt) ) ))
|
|
|
|
(defun $CallDrawPipe( / BasePt Scale OrgOsmode OrgOrthomode OrgSnapmode OrgGridmode OrgPlinewid ) (setq OrgOsmode (getvar "OSMODE") OrgOrthomode (getvar "ORTHOMODE") OrgSnapmode (getvar "SNAPMODE") OrgGridmode (getvar "GRIDMODE") OrgPlinewid (getvar "PLINEWID") ) (setvar "OSMODE" 0) (setvar "ORTHOMODE" 0) (setvar "SNAPMODE" 0) (setvar "GRIDMODE" 0) (setvar "PLINEWID" 0) (setvar "BLIPMODE" 0) (setvar "CMDECHO" 0) (COMMAND "_.COLOR" "BYLAYER") (cond ((= #Unit "mm") (setq Scale #Scale)) ((= #Unit "cm") (setq Scale (* #Scale 0.1))) ((= #Unit "m" ) (setq Scale (* #Scale 0.01))) ) (setq BasePt (getpoint " Pick Base Point --> ")) ($DrawPipe #DrMethod Scale #Rotate #PipeLayer (itoa #PipeCoNo) #CenLayer (itoa #CenCoNo) BasePt ($ChkDataList #MainDia #SubDia #PipeLen)) (setvar "OSMODE" OrgOsmode) (setvar "ORTHOMODE" OrgOrthomode) (setvar "SNAPMODE" OrgSnapmode) (setvar "GRIDMODE" OrgGridmode) (setvar "PLINEWID" OrgPlinewid) (setvar "BLIPMODE" 1) (setvar "CMDECHO" 1))
|
|
|
|
(defun main()(if #LockChk (progn (if (findfile "DrPipe.set") (progn (princ "\n... Initial Condition Setting from 'DrPipe.set' ...\n") (load "DrPipe.set" "\n *** 'DrPipe' Initial Setting Failed *** ") ) ) ($InitSetValue) (if #OkJob (progn ($CallDrawPipe) ($InitPutValue) ) ) ) (princ "\n ***** Don't Copy ******")))
|
|
|
|
(defun c:drpipe() (main)) |