Cross:智能的多曲線相交清理工具
故事:
Cross的故事延續的非常久遠,因為最初的版本還是在20多年之前的AutoCAD R12.0的時代。Cross也是KozMos最早的獨立商業化程序。不過新的Cross與最初的Cross相比,已經是全新設計的軟體了。當然跟Win10與最初DOS時代的Windows 3.1已經完全不是同一個軟體一樣,新舊Cross的最基本的設計核心目標、功能還是一致的,不過新的版本更加智能和方便,功能也更加強大。
在AutoCAD R12.0的時代,PC平台是沒有什麼三維的輔助設計軟體,全部都是在二維的基礎上由線和多義線構成。畫圖的都知道,一張圖紙工作量的80%是在不斷地調整修改設計。使用雙線繪製牆體時,牆體相關的修改會導致需要大量的牆體相交位置的處理,當時是機械地以0為半徑FILLET並一根根點取牆線,實實在在是個體力活。
Cross就是在這種「簡化這種損耗滑鼠左鍵的重複勞動」的需求下出現的,最早的版本是由當時一個師兄設計的。該位老兄當時的程序水平很高,我也是被他帶到自己定製AutoCAD的坑裡的,以致於後來天正等軟體出來之後,從來都不用而一直堅持自己根據需要設計程序完成工作。幸運的是他共享了初代Cross的源代碼給我,在這個基礎上,我也開始慢慢根據自己的實際工作需要進行調整。不過當時自己的水平也實在是比較菜,他的核心演算法完全看不懂,也就沒法做進一步的優化。
第一次突破發生在2000年左右,當時的AutoCAD2000開始支持VLX,相對於AutoCAD R14.0僅能使用VLIDE編譯成ARX的方式,VLX的文件更小,穩定性更高,兼容性也更好。第二次是在2004年,當時已經比較熟練地掌握了Visual LISP,同時在圖形學的研究上也有了更多的心得,程序編製水平和能力也有了較大的提高。在這些基礎上,終於有能力可以重新設計核心處理程序,也開始嘗試將程序發布在互聯網上並收穫了第一個註冊的用戶----來自希臘。
後繼的版本就是在2004年的核心程序基礎上進行擴展,最大的一個擴展是從僅僅支持直線擴展為可以有限支持曲線。Cross程序基本在2006年定型,2015年底正式發布在Autodesk的程序商店。目前的發布僅僅有英文版本,不過與所有的KozMos程序一樣,程序內置同時支持英文、簡體中文和繁體中文,當運行在中文的Windows或者AutoCAD時會自動切換至中文版本。功能:
Cross主要用於清理直線及曲線之間的交叉連接關係,每次處理的直線及曲線數量為兩到四條,根據數目的不同,其結果也各異。在選擇處理的直線及曲線是,直接通過框選並附加圖層過濾的方式,每次框選獲取的直線及曲線數目符合要求時,就直接運行處理。
紅色矩形為矩形選取框
演算法:
因為直線及曲線的數量不同,其結果也可能會各異。為此,在演算法上進行了分組分類的處理方式,根據直線及曲線與框選矩形範圍的關係,進行不同方式的解析:
- 如果直線及曲線的首末點全部位於框選範圍內,則視為多餘的,不參與後繼的直線及曲線數目統計,處理上直接刪除
- 如果直線及曲線的首末點中有一個位於框選範圍內,則視為放射曲線,在處理上以修正框選範圍內端點位置為主
- 如果直線及曲線的首末點均不位於框選範圍內,則視為穿越曲線,對於穿越曲線,僅可能採取兩種處理方式:中間打斷(如果有兩個及以上的交點也位於框選範圍內)或者不處理(作為放射曲線端點調整的邊界)
對於符合數量要求的不同曲線類型組合(如1穿越+2放射,2穿越+2放射,1穿越+1放射),採取枚舉對應組合的處理方式,具體可在APP的幫助文檔中查詢到。
彌合:
對於共線或者部分重合的放射直線,Cross支持自動彌合直線,如下圖。
智能:
因為程序以枚舉的方式來處理各種曲線的組合情況,Cross具有一定程度的智能化處理特徵。但是這種「智能」在底層,是需要用戶根據視圖中曲線的關係來判斷和指定框選範圍。對於同樣的曲線關係,框選範圍不同可能會得到不同的結果:
直曲:
曲線因為自身數據的多樣性(LWPOLYLINE、SPLINE)及複雜性,處理曲線的Cross在處理複雜曲線時可能會出現無法處理或者結果非預想的情況。同時處理曲線時,為獲取位於延長線上的交點,會臨時將放射曲線在框選範圍內延伸。
設置:
Cross支持一些基本的設定,包括處理的線條所在的圖層或者自動進行共線直線的彌合。
----------我是分隔線----------
也是非常遺憾的一件事情,2007年曾經丟失過一次移動硬碟,裡面有所有早期的Cross源程序,很可惜沒有在其他地方備份,早期發布在網上的Cross又都是被編譯過的,就沒有機會將早期的版本源代碼共享出來。
----------我是好消息分隔線----------
今天翻曉東論壇,偶然發現了2003年發表在上面的最早期版本的Cross源代碼,有興趣的可以自行在此下載:
;|這是99年的程序,基本上是後來的SuperCross2002的程序核心。這個程序最早是由梁國標在1993年編的,我做了一點點的優化,加了一些外殼式的模塊。由於在當時的經驗下,程序非常啰嗦,以至於我後來基本都沒有改動主模塊。不過這老兄也可以,我至今都沒有弄清楚演算法。我最近在重新編寫SuperCross2004的代碼,所以把這個古老的代碼翻了出來。開始想參考,不過由於搞不懂,我採用了新的演算法。由於使用了新的演算法,這種演算法就不算什麼了。在此提供給大家源代碼供學習和研究。程序說明:SuperCross僅可以處理由2到4條直線(圖層不限)構成的牆角類型的交叉直線的清理。具體的類型可參照http://www.ikozmos.com/htmls/products/supercross2002.htm。這個軟體是相當智能化的,程序可處理三種最常見的交叉類型:T/+/L雖然已經這麼多年了,還是希望保留所有的版權信息。畢竟尊重別人的勞動就是尊重我們自己的勞動。我都有許多年沒有見到梁國標了,基本上同他已經失去了聯繫。但是說實話,真要謝謝他在最初學習LISP時給的幫助,同時他的這個軟體在過去的許多年裡,也真的給許多人帶來了使用的方便和時間的節省。對本程序的版權聲明如免費軟體。可自由使用,但嚴禁用於商業目的。同時請保留所有已有的版權信息。|;(DEFUN C:CS (/ CS_SETLYR CS_GETMSG CS_CROSS CS_SETUP ) (DEFUN CS_SETLYR (A) (IF (TBLSEARCH "layer" A) (COMMAND "_layer" "_t" A "_u" A "_on" A "_s" A "") (COMMAND "_layer" "_m" A "") ) ) (DEFUN CS_GETMSG (A B / C CS_SUBSTR) (DEFUN CS_SUBSTR (A B C / D E F G H) (SETQ D T) (WHILE D (IF (WCMATCH C (STRCAT "*`" B "*")) (PROGN (SETQ E 1 F (STRLEN B) ) (WHILE E (IF (= B (SUBSTR C E F)) (PROGN (IF (= 1 E) (SETQ G "") (SETQ G (SUBSTR C 1 (1- E) ) ) ) (SETQ H (SUBSTR C (+ E F)) C (STRCAT G A H) E NIL ) ) (SETQ E (1+ E)) ) ) ) (SETQ D NIL) ) ) C ) (IF (NULL B) (SETQ B "") ) (IF (NULL (SETQ C (CDR (ASSOC A CS:APPMSG)))) (SETQ C "") ) (IF (WCMATCH C "*`%1`%*") (SETQ C (CS_SUBSTR B "%1%" C)) ) C ) (DEFUN CS_SETUP () (if (= (getvar "SysCodePage") "ANSI_936") (setq CS:APPMSG (LIST (CONS 0 " 完成! ") (CONS 1 "
請等候釋放對話框數據...") (CONS 2 "應用程序錯誤:
%1%") (CONS 3 "本圖無 42WALL 42層, 自動處理當前層...") (CONS 4 "
請點取欲處理圖層的一個物體 <退出>: ") (CONS 5 "
無效的選擇集, 請重新再試! ") (CONS 6 "
對不起, 未發現有效直線! ") (CONS 7 "
無效的選擇集, 請重新再試! ") (CONS 8 "
[A/放大 S/縮小 D/對中 F/窗口 G/前一窗口 H/幫助]" ) (CONS 9 "
請點取第一角點 [U/回退] <退出> : ") (CONS 10 "
請點取第一角點 <退出> : ") (CONS 11 "
請點取第二角點 <退出> : ") (CONS 12 "
發現 42%1% 42個無效實體, 請重新再試! ") (CONS 13 "
選中的直線總數必須是二到四條! ") (CONS 14 "
請移去多餘的直線 <退出>") (CONS 15 "
請加入不足的直線 <退出>") (CONS 16 "
框選中兩條直線的端點將連接兩條直線! ") (CONS 17 "
幫助幻燈片未發現! ") (CONS 18 "
鍵入任意鍵返回! ") ) ) (setq CS:APPMSG (LIST (CONS 0 " Done!") (CONS 1 "
Waiting for extracting dialog data..." ) (CONS 2 "Application Error:
%1%") (CONS 3 "No layer 42WALL 42,processing current layer..." ) (CONS 4 "
Pick an entity on processing layer <Exit>:" ) (CONS 5 "
Invalid SelectionSet,please retry!" ) (CONS 6 "
Sorry,no valid lines found!") (CONS 7 "
Invalid SelectionSet,please retry!" ) (CONS 8 "
[A/<Zoom 2x>S/<Zoom .5x>D/<Zoom C>F/<Zoom W>G/<Zoom P>H/Help]" ) (CONS 9 "
Please pick first corner [Undo] <Exit>:" ) (CONS 10 "
Please pick first corner <Exit> :" ) (CONS 11 "
Please pick second corner <Exit> :" ) (CONS 12 "
Found 42%1% 42 invalid objects,please retry!" ) (CONS 13 "
The number of selected lines must between 2 to 4!" ) (CONS 14 "
Please remove some lines <Exit>") (CONS 15 "
Please add some lines?Exit>") (CONS 16 "
Window two endpoint will join them by a line!" ) (CONS 17 "
Help Slide NOT found!") (CONS 18 "
Press any key to return!") ) ) ) ) (DEFUN CS_LAYER (/ SELIF ENTIF CS_QUIT N *A *B *AA *BB SS1 SS2 SS3 SSP *V OB1 OB1-STA OB1-END INT1 INT2 OUT1 OUT2 *V CS_SYSVAR CS_CROSS CS_AUNDO CS_INWIN SSS OUT CON1 CON2 SS-A SS-B OB1 OB1-STA OB1-END CS_HELP CS_CROSS ) (DEFUN CS_HELP () (IF (NULL (FINDFILE "cross.sld")) (PRINC (CS_GETMSG 17 NIL)) (PROGN (GRCLEAR) (PRINC (CS_GETMSG 18 NIL)) (COMMAND "vslide" "cross") (GRREAD) (GRREAD) (REDRAW) ) ) ) (DEFUN CS_INWIN (CON01 CON02 PT / A1 B1 C1 D1 PT1 PT2 A2 B2 C2 D2) (SETQ A2 (CAR CON01) B2 (CAR CON02) ) (IF (< A2 B2) (SETQ A1 A2 B1 B2 ) (SETQ A1 B2 B1 A2 ) ) (SETQ C2 (CADR CON01) D2 (CADR CON02) ) (IF (< C2 D2) (SETQ C1 C2 D1 D2 ) (SETQ C1 D2 D1 C2 ) ) (SETQ PT1 (CAR PT) PT2 (CADR PT) ) (IF (AND (AND (>= PT1 A1) (<= PT1 B1)) (AND (>= PT2 C1) (<= PT2 D1)) ) (SETQ OUT "YES") (SETQ OUT "NO") ) (PRINC) ) (DEFUN CS_AUNDO (S) (IF (null G:MARKUNDO) (SETQ G:MARKUNDO 0) ) (COND ((EQUAL S 1) (COMMAND "_undo" "_group")) ((EQUAL S 2) (SETQ G:MARKUNDO (1+ G:MARKUNDO)) (COMMAND "_undo" "_end") ) ((EQUAL S 4) (IF (<= G:MARKUNDO 1) (SETQ G:MARKUNDO NIL) (progn (SETQ G:MARKUNDO (1- G:MARKUNDO)) (COMMAND "u") ) ) ) ) ) (DEFUN CS_REDRAW (A B / N) (SETQ N 0) (REPEAT (SSLENGTH A) (IF B (REDRAW (SSNAME A N) B) (REDRAW (SSNAME A N)) ) (SETQ N (1+ N)) ) ) (DEFUN CS_CROSS (SSS CON1 CON2 / NUM N SS-A SS-B OB1 OB1-STA OB1-END OUT1 OUT2 INT1 INT2 INT3 INT4 INT5 INT6 INT11 INT12 INT13 INT14 INT22 INT23 INT24 INT34 INT LINE1 LINE2 LINE3 LINE4 LINE5 LINE6 LINE7 LINE8 LINE6A LINE6B LINE7A LINE7B LINE0 LINE0A LINE0B LINE1A LINE1B LINE2A LINE2B LINE3A LINE3C LINE4A LIN4B LINE5A LINE5B ANG1 ANG2 ANG3 ANG4 ) (SETQ NUM (SSLENGTH SSS)) (IF (EQUAL NUM 3) (PROGN (SETQ LINE8 NIL LINE7 NIL LINE5 NIL LINE4 NIL LINE3 NIL LINE2 NIL LINE1 NIL LINE0 NIL LINE0A NIL LINE0B NIL LINE1A NIL LINE1B NIL LINE2A NIL LINE2B NIL LINE3A NIL LINE3B NIL LINE4A NIL LINE4B NIL LINE5A NIL LINE5B NIL N 0 SS-A (SSADD) SS-B (SSADD) ) (REPEAT NUM (SETQ OB1 (SSNAME SSS N) OB1-STA (CDR (ASSOC 10 (ENTGET OB1))) OB1-END (CDR (ASSOC 11 (ENTGET OB1))) ) (CS_INWIN CON1 CON2 OB1-STA) (SETQ OUT1 OUT) (CS_INWIN CON1 CON2 OB1-END) (SETQ OUT2 OUT) (COND ((AND (EQUAL OUT1 "YES") (EQUAL OUT2 "YES") ) (IF (NULL LINE7) (SETQ LINE7 OB1 LINE7A OB1-STA LINE7B OB1-END ) (SETQ LINE8 OB1) ) ) ((AND (EQUAL OUT1 "NO") (EQUAL OUT2 "NO")) (SETQ SS-B (SSADD OB1 SS-B)) (IF (NULL LINE2) (SETQ LINE2 OB1 LINE2A OB1-STA LINE2B OB1-END ) (IF (NULL LINE1) (SETQ LINE1 OB1 LINE1A OB1-STA LINE1B OB1-END ) (SETQ LINE0 OB1 LINE0A OB1-STA LINE0B OB1-END ) ) ) ) ((EQUAL OUT1 "YES") (SETQ SS-A (SSADD OB1 SS-A)) (IF LINE0 (SETQ LINE1A OB1-STA LINE1B OB1-END LINE1 OB1 ) (SETQ LINE0A OB1-STA LINE0B OB1-END LINE0 OB1 ) ) ) ((EQUAL OUT2 "YES") (SETQ SS-A (SSADD OB1 SS-A)) (IF LINE0 (SETQ LINE1A OB1-END LINE1B OB1-STA LINE1 OB1 ) (SETQ LINE0A OB1-END LINE0B OB1-STA LINE0 OB1 ) ) ) ) (SETQ N (1+ N)) ) (SETQ NUM (SSLENGTH SS-B)) (COND (LINE8 (PRINC (CS_GETMSG 5 NIL)) (SETQ LINE8 NIL) ) ((> NUM 1) (SETQ INT1 (INTERS LINE2A LINE2B LINE1A LINE1B) INT2 (INTERS LINE2A LINE2B LINE0A LINE0B) INT3 (INTERS LINE1A LINE1B LINE0A LINE0B) ) (COND ((EQUAL INT1 NIL) (COMMAND "_.Break" LINE0 INT2 INT3) ) ((EQUAL INT2 NIL) (COMMAND "_.Break" LINE1 INT1 INT3) ) ((EQUAL INT3 NIL) (COMMAND "_.Break" LINE2 INT1 INT2) ) ) ) (LINE7 (SETQ INT1 (INTERS LINE7A LINE7B LINE0A LINE0B NIL) INT2 (INTERS LINE7A LINE7B LINE1A LINE1B NIL) ) (COMMAND "_.Erase" LINE0 LINE1 LINE7 "" "_.Break" LINE7 INT1L INT2 "_.Line" LINE0B INT1 "" "_.Line" LINE1B INT2 "" "_.Line" INT1 INT2 "" ) ) (T (SETQ INT1 (INTERS LINE2A LINE2B LINE0A LINE0B NIL) INT2 (INTERS LINE2A LINE2B LINE1A LINE1B NIL) ) (IF (< (DISTANCE INT1 LINE2A) (DISTANCE INT2 LINE2A) ) (SETQ INT3 INT1 INT4 LINE0B ) (SETQ INT3 INT2 INT4 LINE1B ) ) (IF (< (DISTANCE INT1 LINE2B) (DISTANCE INT2 LINE2B) ) (SETQ INT5 INT1 INT6 LINE0B ) (SETQ INT5 INT2 INT6 LINE1B ) ) (COMMAND "_.Erase" LINE2 LINE1 LINE0 "" "_.Line" INT3 LINE2A "" "_.Line" INT5 LINE2B "" "_.Line" INT3 INT4 "" "_.Line" INT5 INT6 "" ) ) ) ) (PROGN (SETQ LINE7 NIL LINE6 NIL LINE5 NIL LINE4 NIL LINE3 NIL LINE2 NIL LINE1 NIL LINE0 NIL INT1 NIL INT2 NIL INT3 NIL INT4 NIL INT5 NIL INT6 NIL N 0 SS-A (SSADD) SS-B (SSADD) NUM (SSLENGTH SSS) ) (REPEAT NUM (SETQ OB1 (SSNAME SSS N) OB1-STA (CDR (ASSOC 10 (ENTGET OB1))) OB1-END (CDR (ASSOC 11 (ENTGET OB1))) ) (CS_INWIN CON1 CON2 OB1-STA) (SETQ OUT1 OUT) (CS_INWIN CON1 CON2 OB1-END) (SETQ OUT2 OUT) (COND ((AND (EQUAL OUT1 "NO") (EQUAL OUT2 "NO")) (SETQ SS-B (SSADD OB1 SS-B)) (COND ((NULL LINE0) (SETQ LINE0 OB1 LINE0A OB1-STA LINE0B OB1-END ) ) ((NULL LINE1) (SETQ LINE1 OB1 LINE1A OB1-STA LINE1B OB1-END ) ) ((NULL LINE2) (SETQ LINE2 OB1 LINE2A OB1-STA LINE2B OB1-END ) ) ((NULL LINE3) (SETQ LINE3 OB1 LINE3A OB1-STA LINE3B OB1-END ) ) ) ) ((AND (EQUAL OUT1 "YES") (EQUAL OUT2 "NO") ) (SETQ SS-A (SSADD OB1 SS-A)) (COND ((NULL LINE4) (SETQ LINE4 OB1 LINE4A OB1-STA LINE4B OB1-END ) ) ((NULL LINE5) (SETQ LINE5 OB1 LINE5A OB1-STA LINE5B OB1-END ) ) ((NULL LINE6) (SETQ LINE6 OB1 LINE6A OB1-STA LINE6B OB1-END ) ) ((NULL LINE7) (SETQ LINE7 OB1 LINE7A OB1-STA LINE7B OB1-END ) ) (T (PRINC (CS_GETMSG 6 NIL))) ) ) ((AND (EQUAL OUT2 "YES") (EQUAL OUT1 "NO") ) (SETQ SS-A (SSADD OB1 SS-A)) (COND ((NULL LINE4) (SETQ LINE4 OB1 LINE4A OB1-END LINE4B OB1-STA ) ) ((NULL LINE5) (SETQ LINE5 OB1 LINE5A OB1-END LINE5B OB1-STA ) ) ((NULL LINE6) (SETQ LINE6 OB1 LINE6A OB1-END LINE6B OB1-STA ) ) ((NULL LINE7) (SETQ LINE7 OB1 LINE7A OB1-END LINE7B OB1-STA ) ) (T (PRINC (CS_GETMSG 7 NIL))) ) ) ) (SETQ N (1+ N)) ) (SETQ NUM (SSLENGTH SS-B)) (COND ((EQUAL NUM 4) (SETQ INT1 (INTERS LINE0A LINE0B LINE1A LINE1B) INT2 (INTERS LINE0A LINE0B LINE2A LINE2B) INT3 (INTERS LINE0A LINE0B LINE3A LINE3B) ) (COND ((NULL INT1) (SETQ LINE4 LINE1 LINE4A LINE1A LINE4B LINE1B LINE5 LINE2 LINE5A LINE2A LINE5B LINE2B LINE6 LINE3 LINE6A LINE3A LINE6B LINE3B ) ) ((NULL INT2) (SETQ LINE4 LINE2 LINE4A LINE2A LINE4B LINE2B LINE5 LINE1 LINE5A LINE1A LINE5B LINE1B LINE6 LINE3 LINE6A LINE3A LINE6B LINE3B ) ) ((NULL INT3) (SETQ LINE4 LINE3 LINE4A LINE3A LINE4B LINE3B LINE5 LINE1 LINE5A LINE1A LINE5B LINE1B LINE6 LINE2 LINE6A LINE2A LINE6B LINE2B ) ) ) (SETQ INT1 (INTERS LINE0A LINE0B LINE5A LINE5B) INT2 (INTERS LINE0A LINE0B LINE6A LINE6B) INT11 (INTERS LINE4A LINE4B LINE5A LINE5B ) INT22 (INTERS LINE4A LINE4B LINE6A LINE6B ) ) (COMMAND "_.Break" LINE0 INT1 INT2) (COMMAND "_.Break" LINE4 INT11 INT22) (COMMAND "_.Break" LINE5 INT1 INT11) (COMMAND "_.Break" LINE6 INT2 INT22) ) ((EQUAL NUM 2) (SETQ INT1 (INTERS LINE4A LINE4B LINE5A LINE5B NIL) INT2 (INTERS LINE4A LINE4B LINE4A LINE5B) ) (COND ((NULL INT1) (SETQ ANG1 (ANGLE LINE4A LINE4B) ANG2 (ANGLE LINE5A LINE5B) ANG3 (ANGLE LINE5B LINE5A) ) (COND ((AND INT2 (EQUAL ANG1 ANG2 0.005)) (SETQ INT1 (INTERS LINE4A LINE4B LINE0A LINE0B NIL) INT2 (INTERS LINE4A LINE4B LINE1A LINE1B NIL) ) (IF (< (DISTANCE INT1 LINE4B) (DISTANCE INT2 LINE4B) ) (SETQ LINE6 LINE0 LINE6A LINE0A LINE6B LINE0B INT INT1 ) (SETQ LINE6 LINE1 LINE6A LINE1A LINE6B LINE1B INT INT2 ) ) (SETQ INT3 (INTERS LINE5A LINE5B LINE6A LINE6B NIL) ) (COMMAND "_.Erase" LINE4 LINE5 "" "_.Line" INT LINE4B "" "_.Line" INT3 LINE5B "" "_.Break" LINE6 INT INT3 ) ) ((EQUAL ANG1 ANG3 0.005) (SETQ INT1 (INTERS LINE4A LINE4B LINE0A LINE0B NIL) INT2 (INTERS LINE4A LINE4B LINE1A LINE1B NIL) INT11 (INTERS LINE5A LINE5B LINE0A LINE0B NIL) INT22 (INTERS LINE5A LINE5B LINE1A LINE1B NIL) ) (IF (< (DISTANCE INT1 LINE4B) (DISTANCE INT2 LINE4B) ) (SETQ INT3 INT1) (SETQ INT3 INT2) ) (IF (< (DISTANCE INT11 LINE5B) (DISTANCE INT22 LINE5B) ) (SETQ INT4 INT11) (SETQ INT4 INT22) ) (COMMAND "_.Erase" LINE4 LINE5 "" "_.Line" LINE4B INT3 "" "_.Line" LINE5B INT4 "" ) ) (T (PRINC (CS_GETMSG 7 NIL))) ) ) (INT1 (SETQ INT1 (INTERS LINE4A LINE4B LINE0A LINE0B NIL) INT2 (INTERS LINE4A LINE4B LINE1A LINE1B NIL) INT11 (INTERS LINE5A LINE5B LINE0A LINE0B NIL) INT22 (INTERS LINE5A LINE5B LINE1A LINE1B NIL) ) (IF (< (DISTANCE INT1 LINE4B) (DISTANCE INT2 LINE4B) ) (SETQ INT3 INT1 INT4 LINE4B ) (SETQ INT3 INT2 INT4 LINE4B ) ) (IF (< (DISTANCE INT11 LINE5B) (DISTANCE INT22 LINE5B) ) (SETQ INT5 INT11 INT6 LINE5B ) (SETQ INT5 INT22 INT6 LINE5B ) ) (COMMAND "_.Erase" LINE4 LINE5 "" "_.Line" INT3 LINE4B "" "_.Line" INT5 LINE5B "" ) ) (T (PRINC (CS_GETMSG 7 NIL))) ) ) ((EQUAL NUM 0) (SETQ INT1 (INTERS LINE4A LINE4B LINE5A LINE5B NIL) INT2 (INTERS LINE4A LINE4B LINE6A LINE6B NIL) INT3 (INTERS LINE4A LINE4B LINE7A LINE7B NIL) ) (COND ((NULL INT1) (SETQ LINE0 LINE5 LINE0A LINE5A LINE0B LINE5B LINE1 LINE6 LINE1A LINE6A LINE1B LINE6B LINE2 LINE7 LINE2A LINE7A LINE2B LINE7B ) ) ((NULL INT2) (SETQ LINE0 LINE6 LINE0A LINE6A LINE0B LINE6B LINE1 LINE5 LINE1A LINE5A LINE1B LINE5B LINE2 LINE7 LINE2A LINE7A LINE2B LINE7B ) ) ((NULL INT3) (SETQ LINE0 LINE7 LINE0A LINE7A LINE0B LINE7B LINE1 LINE5 LINE1A LINE5A LINE1B LINE5B LINE2 LINE6 LINE2A LINE6A LINE2B LINE6B ) ) ) (COND ((NULL (AND INT1 INT2 INT3)) (SETQ INT1 (INTERS LINE4A LINE4B LINE1A LINE1B NIL) INT2 (INTERS LINE4A LINE4B LINE2A LINE2B NIL) INT11 (INTERS LINE0A LINE0B LINE1A LINE1B NIL) INT22 (INTERS LINE0A LINE0B LINE2A LINE2B NIL) INT23 (INTERS LINE0A LINE4B LINE0B LINE4B ) INT24 (INTERS LINE1A LINE2B LINE1B LINE2B ) ANG1 (ANGLE LINE4A LINE4B) ANG2 (ANGLE LINE0A LINE0B) ANG3 (ANGLE LINE1A LINE1B) ANG4 (ANGLE LINE2A LINE2B) ) (COND ((AND (EQUAL ANG1 ANG2 0.005) (EQUAL ANG3 ANG4 0.005) ) (IF (< (DISTANCE INT1 LINE1B) (DISTANCE INT11 LINE1B) ) (PROGN (IF (< (DISTANCE INT1 LINE4B ) (DISTANCE INT2 LINE4B ) ) (SETQ INT3 INT1 INT4 LINE1B ) (SETQ INT3 INT2 INT4 LINE2B ) ) (IF (> (DISTANCE INT11 LINE0B ) (DISTANCE INT22 LINE0B ) ) (SETQ INT5 INT11 INT6 LINE1B ) (SETQ INT5 INT22 INT6 LINE2B ) ) ) (PROGN (IF (> (DISTANCE INT1 LINE4B ) (DISTANCE INT2 LINE4B ) ) (SETQ INT3 INT1 INT4 LINE1B ) (SETQ INT3 INT2 INT4 LINE2B ) ) (IF (< (DISTANCE INT11 LINE0B ) (DISTANCE INT22 LINE0B ) ) (SETQ INT5 INT11 INT6 LINE1B ) (SETQ INT5 INT22 INT6 LINE2B ) ) ) ) (COMMAND "_.Erase" LINE0 LINE4 LINE1 LINE2 "") (COMMAND "_.Line" LINE4B INT3 "") (COMMAND "_.Line" INT4 INT3 "") (COMMAND "_.Line" LINE0B INT5 "") (COMMAND "_.Line" INT6 INT5 "") ) ((OR (NULL INT23) (NULL INT24)) (IF (NULL INT23) (PROGN (IF (< (DISTANCE INT1 LINE4B ) (DISTANCE INT2 LINE4B ) ) (SETQ INT3 INT1 INT4 LINE1B ) (SETQ INT3 INT2 INT4 LINE2B ) ) (IF (< (DISTANCE INT11 LINE0B ) (DISTANCE INT22 LINE0B ) ) (SETQ INT5 INT11 INT6 LINE1B ) (SETQ INT5 INT22 INT6 LINE2B ) ) (COMMAND "_.Erase" LINE0 LINE4 LINE1 LINE2 "" ) (COMMAND "_.Line" LINE4B INT3 "" ) (COMMAND "_.Line" INT4 INT3 "" ) (COMMAND "_.Line" LINE0B INT5 "" ) (COMMAND "_.Line" INT6 INT5 "" ) ) (PROGN (IF (< (DISTANCE INT1 LINE1B ) (DISTANCE INT11 LINE1B ) ) (SETQ INT3 INT1 INT4 LINE4B ) (SETQ INT3 INT11 INT4 LINE0B ) ) (IF (< (DISTANCE INT2 LINE2B ) (DISTANCE INT22 LINE2B ) ) (SETQ INT5 INT2 INT6 LINE4B ) (SETQ INT5 INT22 INT6 LINE0B ) ) (COMMAND "_.Erase" LINE0 LINE4 LINE1 LINE2 "" ) (COMMAND "_.Line" LINE1B INT3 "" ) (COMMAND "_.Line" INT4 INT3 "" ) (COMMAND "_.Line" LINE2B INT5 "" ) (COMMAND "_.Line" INT6 INT5 "" ) ) ) ) (T (IF (EQUAL ANG3 ANG4 0.005) (PROGN (IF (< (DISTANCE INT1 LINE4B ) (DISTANCE INT2 LINE4B ) ) (SETQ INT3 INT1 INT4 LINE1B ) (SETQ INT3 INT2 INT4 LINE2B ) ) (IF (< (DISTANCE INT11 LINE0B ) (DISTANCE INT22 LINE0B ) ) (SETQ INT5 INT11 INT6 LINE1B ) (SETQ INT5 INT22 INT6 LINE2B ) ) (COMMAND "_.Erase" LINE0 LINE4 LINE1 LINE2 "" ) (COMMAND "_.Line" LINE4B INT3 "" ) (COMMAND "_.Line" INT4 INT3 "" ) (COMMAND "_.Line" LINE0B INT5 "" ) (COMMAND "_.Line" INT6 INT5 "" ) ) (PROGN (IF (< (DISTANCE INT1 LINE1B ) (DISTANCE INT11 LINE1B ) ) (SETQ INT3 INT1 INT4 LINE4B ) (SETQ INT3 INT11 INT4 LINE0B ) ) (IF (< (DISTANCE INT2 LINE2B ) (DISTANCE INT22 LINE2B ) ) (SETQ INT5 INT2 INT6 LINE4B ) (SETQ INT5 INT22 INT6 LINE0B ) ) (COMMAND "_.Erase" LINE0 LINE4 LINE1 LINE2 "" ) (COMMAND "_.Line" LINE1B INT3 "" ) (COMMAND "_.Line" INT4 INT3 "" ) (COMMAND "_.Line" LINE2B INT5 "" ) (COMMAND "_.Line" INT6 INT5 "" ) ) ) ) ) ) ((AND INT1 INT2 INT3) (SETQ INT1 (INTERS LINE4A LINE4B LINE5A LINE5B NIL) INT2 (INTERS LINE4A LINE4B LINE6A LINE6B NIL) INT3 (INTERS LINE4A LINE4B LINE7A LINE7B NIL) INT4 (INTERS LINE5A LINE5B LINE6A LINE6B NIL) INT5 (INTERS LINE5A LINE5B LINE7A LINE7B NIL) INT6 (INTERS LINE6A LINE6B LINE7A LINE7B NIL) N NIL ) (COND ((NULL INT1) (SETQ LINE0 LINE4 LINE0A LINE4A LINE0B LINE4B LINE1 LINE5 LINE1A LINE5A LINE1B LINE5B LINE2 LINE6 LINE2A LINE6A LINE2B LINE6B LINE3 LINE7 LINE3A LINE7A LINE3B LINE7B N 1 ) ) ((NULL INT2) (SETQ LINE0 LINE4 LINE0A LINE4A LINE0B LINE4B LINE1 LINE6 LINE1A LINE6A LINE1B LINE6B LINE2 LINE5 LINE2A LINE5A LINE2B LINE5B LINE3 LINE7 LINE3A LINE7A LINE3B LINE7B N 2 ) ) ((NULL INT3) (SETQ LINE0 LINE4 LINE0A LINE4A LINE0B LINE4B LINE1 LINE7 LINE1A LINE7A LINE1B LINE7B LINE2 LINE5 LINE2A LINE5A LINE2B LINE5B LINE3 LINE6 LINE3A LINE6A LINE3B LINE6B N 3 ) ) ((NULL INT4) (SETQ LINE0 LINE5 LINE0A LINE5A LINE0B LINE5B LINE1 LINE6 LINE1A LINE6A LINE1B LINE6B LINE2 LINE4 LINE2A LINE4A LINE2B LINE4B LINE3 LINE7 LINE3A LINE7A LINE3B LINE7B N 4 ) ) ((NULL INT5) (SETQ LINE0 LINE5 LINE0A LINE5A LINE0B LINE5B LINE1 LINE7 LINE1A LINE7A LINE1B LINE7B LINE2 LINE4 LINE2A LINE4A LINE2B LINE4B LINE3 LINE6 LINE3A LINE6A LINE3B LINE6B N 5 ) ) ((NULL INT6) (SETQ LINE0 LINE6 LINE0A LINE6A LINE0B LINE6B LINE1 LINE7 LINE1A LINE7A LINE1B LINE7B LINE2 LINE4 LINE2A LINE4A LINE2B LINE4B LINE3 LINE5 LINE3A LINE5A LINE3B LINE5B N 6 ) ) ) (COND ((EQUAL N NIL) (PRINC (CS_GETMSG 7 NIL)) (SETQ SELIF "OKLINE") ) (T (SETQ INT1 (INTERS LINE2A LINE2B LINE0A LINE0B NIL ) INT2 (INTERS LINE2A LINE2B LINE1A LINE1B NIL ) INT11 (INTERS LINE3A LINE3B LINE0A LINE0B NIL ) INT22 (INTERS LINE3A LINE3B LINE1A LINE1B NIL ) ) (IF (< (DISTANCE INT1 LINE2B) (DISTANCE INT2 LINE2B) ) (SETQ INT3 INT1 INT4 LINE0B ) (SETQ INT3 INT2 INT4 LINE1B ) ) (IF (< (DISTANCE INT11 LINE3B) (DISTANCE INT22 LINE3B) ) (SETQ INT5 INT11 INT6 LINE0B ) (SETQ INT5 INT22 INT6 LINE1B ) ) (COMMAND "_.Erase" LINE0 LINE1 LINE2 LINE3 "") (COMMAND "_.Line" LINE2B INT3 "" "_.Line" LINE3B INT5 "" "_.Line" INT4 INT3 "" "_.Line" INT6 INT5 "" ) ) ) ) ) ) (T (PRINC (CS_GETMSG 7 NIL)) (SETQ SELIF "OKLINE") ) ) ) ) ) (SETQ SELIF NIL ENTIF NIL UNDOMARK NIL ) (WHILE (NULL CS_QUIT) (IF UNDOMARK (CS_AUNDO 2) ) (PROGN (IF SSP (SETQ SS1 SSP SSP NIL SELIF "OK" ) ) (WHILE (NULL SELIF) (WHILE (NULL ENTIF) (SETVAR "osmode" 0) (SETVAR "aperture" 1) (SETVAR "pickbox" 1) (PRINC (CS_GETMSG 8 NIL)) (IF UNDOMARK (PROGN (INITGET "Help Exit A S D F G Undo") (SETQ ENTIF (GETPOINT (CS_GETMSG 9 NIL) ) ) ) (PROGN (INITGET "Help Exit A S D F G") (SETQ ENTIF (GETPOINT (CS_GETMSG 10 NIL) ) ) ) ) (COND ((OR (EQUAL ENTIF NIL) (EQUAL ENTIF "Exit") ) (SETQ SELIF "cs_quit" ENTIF T ) (IF SS3 (CS_REDRAW SS3 NIL) ) ) ((EQUAL ENTIF "A") (COMMAND "zoom" "2x") (SETQ ENTIF NIL) (IF SS3 (CS_REDRAW SS3 3) ) ) ((EQUAL ENTIF "S") (COMMAND "zoom" ".5x") (SETQ ENTIF NIL) (IF SS3 (CS_REDRAW SS3 3) ) ) ((EQUAL ENTIF "D") (SETVAR "cmdecho" 1) (COMMAND "zoom" "c") (SETVAR "cmdecho" 0) (COMMAND PAUSE "") (SETQ ENTIF NIL) (IF SS3 (CS_REDRAW SS3 3) ) ) ((EQUAL ENTIF "F") (SETVAR "cmdecho" 1) (COMMAND "zoom" "w" PAUSE PAUSE) (SETQ ENTIF NIL) (SETVAR "cmdecho" 0) (IF SS3 (CS_REDRAW SS3 3) ) ) ((EQUAL ENTIF "G") (COMMAND "zoom" "p") (SETQ ENTIF NIL) (IF SS3 (CS_REDRAW SS3 3) ) ) ((EQUAL ENTIF "Help") (SETQ ENTIF NIL) (CS_HELP) (IF SS3 (CS_REDRAW SS3 3) ) ) ((EQUAL ENTIF "Undo") (CS_AUNDO 4) (SETQ ENTIF NIL) ) (T (SETQ *A ENTIF UNDOMARK "KozmoSoft" ) (IF SS3 (CS_REDRAW SS3 NIL) ) (INITGET 39) (SETQ *B (GETCORNER *A (CS_GETMSG 11 NIL)) SS1 (SSGET "w" *A *B (list (cons 0 "LINE")) ) ) (IF SS1 (COMMAND "_.Erase" SS1 "") ) (SETQ SS1 (SSGET "c" *A *B (list (cons 0 "LINE")) ) ) (IF SS1 (SETQ SELIF "OK") (PROGN (SETQ ENTIF NIL) (PRINC (CS_GETMSG 6 NIL)) ) ) ) ) ) ) (CS_AUNDO 1) (SETQ N 0 SS2 (SSADD) SS3 (SSADD) ) (IF (EQUAL SELIF "OK") (PROGN (REPEAT (SSLENGTH SS1) (SETQ *AA (CDR (ASSOC 0 (ENTGET (SETQ *BB (SSNAME SS1 N ) ) ) ) ) ) (IF (EQUAL *AA "LINE") (SSADD *BB SS2) (SSADD *BB SS3) ) (SETQ N (1+ N)) ) (IF (EQUAL (SSLENGTH SS1) (SSLENGTH SS2)) (SETQ SELIF "OKALL") (SETQ SELIF "NOTLINE") ) ) (PRINC) ) (IF (EQUAL SELIF "OKALL") (COND ((AND (> (SSLENGTH SS2) 1) (< (SSLENGTH SS2) 5) ) (SETQ SELIF "OKLINE") ) ((< (SSLENGTH SS2) 2) (SETQ SELIF "FEWLINE")) ((> (SSLENGTH SS2) 4) (SETQ SELIF "TOOLINE")) ) (PRINC) ) (IF (EQUAL SELIF "OKLINE") (IF (= (SSLENGTH SS2) 2) (SETQ SELIF "TWOLINE") ) (PRINC) ) (SETQ N 0) (IF (EQUAL SELIF "OKLINE") (REPEAT (SSLENGTH SS2) (REDRAW (SSNAME SS1 N) 3) (SETQ N (1+ N)) ) ) (SETQ N 0) (IF (EQUAL SELIF "NOTLINE") (REPEAT (SSLENGTH SS3) (REDRAW (SSNAME SS3 N) 3) (SETQ N (1+ N)) ) ) (COND ((EQUAL SELIF "cs_quit") (PRINC)) ((EQUAL SELIF "NOTLINE") (SETQ N (SSLENGTH SS3) SELIF "OKLINE" ENTIF NIL ) (PRINC (CS_GETMSG 12 (ITOA N))) ) ((EQUAL SELIF "TOOLINE") (PRINC (CS_GETMSG 13 NIL)) (PRINC (CS_GETMSG 14 NIL)) (SETVAR "highlight" 1) (SETVAR "pickbox" 5) (COMMAND "select" SS1 "r" PAUSE) (SETQ SSP (SSGET "P")) (IF (EQUAL (SSLENGTH SSP) (SSLENGTH SS1)) (SETQ SELIF "cs_quit" SSP NIL ) (SETQ SELIF "OKLINE") ) ) ((EQUAL SELIF "FEWLINE") (PRINC (CS_GETMSG 13 NIL)) (PRINC (CS_GETMSG 15 NIL)) (SETVAR "highlight" 1) (SETVAR "pickbox" 5) (COMMAND "select" SS1 "a" PAUSE) (SETQ SSP (SSGET "P")) (IF (EQUAL (SSLENGTH SSP) (SSLENGTH SS1)) (SETQ SELIF "cs_quit" SSP NIL ) (SETQ SELIF "OKLINE") ) ) ((EQUAL SELIF "TWOLINE") (SETQ OB1 (SSNAME SS1 0) OB1-STA (CDR (ASSOC 10 (ENTGET OB1))) OB1-END (CDR (ASSOC 11 (ENTGET OB1))) ) (CS_INWIN *A *B OB1-STA) (SETQ OUT1 OUT) (CS_INWIN *A *B OB1-END) (SETQ OUT2 OUT) (COND ((AND (EQUAL OUT1 "YES") (EQUAL OUT2 "NO")) (SETQ INT1 OB1-STA) ) ((AND (EQUAL OUT1 "NO") (EQUAL OUT2 "YES")) (SETQ INT1 OB1-END) ) (T (PRINC)) ) (SETQ OB1 (SSNAME SS1 1) OB1-STA (CDR (ASSOC 10 (ENTGET OB1))) OB1-END (CDR (ASSOC 11 (ENTGET OB1))) ) (CS_INWIN *A *B OB1-STA) (SETQ OUT1 OUT) (CS_INWIN *A *B OB1-END) (SETQ OUT2 OUT) (COND ((AND (EQUAL OUT1 "YES") (EQUAL OUT2 "NO")) (SETQ INT2 OB1-STA) ) ((AND (EQUAL OUT1 "NO") (EQUAL OUT2 "YES")) (SETQ INT2 OB1-END) ) (T (PRINC)) ) (IF (AND INT1 INT2) (PROGN (COMMAND "_.Line" INT1 INT2 "") (SETQ SELIF "OKLINE") ) (PROGN (SETQ SELIF "OKLINE") (PRINC (CS_GETMSG 16 NIL)) ) ) ) ((EQUAL SELIF "OKLINE") (CS_CROSS SS1 *A *B)) ) (IF (EQUAL SELIF "OKLINE") (CS_REDRAW SS2 NIL) ) (IF (EQUAL SELIF "OKLINE") (PROGN (SETQ SELIF NIL ENTIF NIL CS_QUIT NIL ) (IF SSP (SETQ SELIF T ENTIF T ) ) ) (SETQ CS_QUIT T) ) ) ) ) (CS_SETUP) (CS_LAYER))
推薦閱讀:
※對 Lisp 新手來說,學習哪種方言、使用哪些參考書和開發軟體更適合?
※你能想到的幾乎所有關於行的操作
※Lisp machine 這種用 Lisp 代碼當機器的彙編指令的硬體實現為什麼銷聲匿跡了?硬體和 Lisp 這樣的高級語言兩個極端如何融合在一起?
※Lisp的精髓是什麼?
※總結篇3 解釋器 —— Interpreter