[分享]：矩形裁剪的最智能化工具，源代码（for 14~2004）

mmmm · 发表于 2003-12-20 20:14:05

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;|
这是99年的程序，基本上是后来的SuperCross2002的程序核心。
这个程序最早是由梁国标在1993年编的，我做了一点点的优化，加了一些外壳式的模块。
由于在当时的经验下，程序非常啰嗦，以至于我后来基本都没有改动主模块。不过这老
兄也可以，我至今都没有弄清楚起算法。
我最近在重新编写SuperCross2004的代码，所以把这个古老的代码翻了出来。开始想参考，
不过由于搞不懂，我采用了新的算法。由于使用了新的算法，这种算法就不算什么了。在
此提供给大家源代码供学习和研究。
程序说明：
SuperCross仅可以处理由2到4条直线（图层不限）构成的墙角类型的交叉直线的清理。
具体的类型可参照[url]http://www.ikozmos.com/htmls/products/supercross2002.htm[/url]
这个软件是相当智能化的，程序可处理三种最常见的交叉类型：T/+/L
虽然已经这么多年了，还是希望保留所有的版权信息。
毕竟尊重别人的劳动就是尊重我们自己的劳动。
我都有许多年没有见到梁国标了，基本上同他已经失去了联系。但是说实话，真要谢谢他
在最初学习AutoLISP时给的帮助，同时他的这个软件在过去的许多年里，也真的给许多人
带来了使用的方便和时间的节省。
对本程序的版权声明如免费软件。可自由使用，但严禁用于商业目的。同时请保留所有
已有的版权信息。
|;
(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 "\n 请等候释放对话框数据...")
(CONS 2 "应用程序错误:\n %1%")
(CONS 3 "本图无\042WALL\042层, 自动处理当前层...")
(CONS 4 "\n 请点取欲处理图层的一个物体 <退出>: ")
(CONS 5 "\n 无效的选择集, 请重新再试! ")
(CONS 6 "\n 对不起, 未发现有效直线! ")
(CONS 7 "\n 无效的选择集, 请重新再试! ")
(CONS 8
"\n [A/放大 S/缩小 D/对中 F/窗口 G/前一窗口 H/帮助]"
)
(CONS 9 "\n 请点取第一角点 [U/回退] <退出> : ")
(CONS 10 "\n 请点取第一角点 <退出> : ")
(CONS 11 "\n 请点取第二角点 <退出> : ")
(CONS 12 "\n 发现\042%1%\042个无效实体, 请重新再试! ")
(CONS 13 "\n 选中的直线总数必须是二到四条! ")
(CONS 14 "\n 请移去多余的直线 <退出>")
(CONS 15 "\n 请加入不足的直线 <退出>")
(CONS 16 "\n 框选中两条直线的端点将连接两条直线! ")
(CONS 17 "\n 帮助幻灯片未发现! ")
(CONS 18 "\n 键入任意键返回! ")
)
)
(setq CS:APPMSG
(LIST
(CONS 0 " Done!")
(CONS 1
"\n Waiting for extracting dialog data..."
)
(CONS 2 "Application Error:\n %1%")
(CONS
3
"No layer \042WALL\042,processing current layer..."
)
(CONS
4
"\n Pick an entity on processing layer <Exit>:"
)
(CONS 5
"\n Invalid SelectionSet,please retry!"
)
(CONS 6 "\n Sorry,no valid lines found!")
(CONS 7
"\n Invalid SelectionSet,please retry!"
)
(CONS
8
"\n [A/<Zoom 2x>S/<Zoom .5x>D/<Zoom C>F/<Zoom W>G/<Zoom P>H/Help]"
)
(CONS
9
"\n Please pick first corner [Undo] <Exit>:"
)
(CONS 10
"\n Please pick first corner <Exit> :"
)
(CONS 11
"\n Please pick second corner <Exit> :"
)
(CONS
12
"\n Found \042%1%\042 invalid objects,please retry!"
)
(CONS
13
"\n The number of selected lines must between 2 to 4!"
)
(CONS 14 "\n Please remove some lines <Exit>")
(CONS 15 "\n Please add some lines?Exit>")
(CONS
16
"\n Window two endpoint will join them by a line!"
)
(CONS 17 "\n Help Slide NOT found!")
(CONS 18 "\n 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)
)

;| 
这是99年的程序，基本上是后来的SuperCross2002的程序核心。 
这个程序最早是由梁国标在1993年编的，我做了一点点的优化，加了一些外壳式的模块。 
由于在当时的经验下，程序非常啰嗦，以至于我后来基本都没有改动主模块。不过这老 
兄也可以，我至今都没有弄清楚起算法。 
我最近在重新编写SuperCross2004的代码，所以把这个古老的代码翻了出来。开始想参考， 
不过由于搞不懂，我采用了新的算法。由于使用了新的算法，这种算法就不算什么了。在 
此提供给大家源代码供学习和研究。 
 
程序说明： 
SuperCross仅可以处理由2到4条直线（图层不限）构成的墙角类型的交叉直线的清理。 
具体的类型可参照[url]http://www.ikozmos.com/htmls/products/supercross2002.htm[/url] 
这个软件是相当智能化的，程序可处理三种最常见的交叉类型：T/+/L 
 
虽然已经这么多年了，还是希望保留所有的版权信息。 
毕竟尊重别人的劳动就是尊重我们自己的劳动。 
 
我都有许多年没有见到梁国标了，基本上同他已经失去了联系。但是说实话，真要谢谢他 
在最初学习AutoLISP时给的帮助，同时他的这个软件在过去的许多年里，也真的给许多人 
带来了使用的方便和时间的节省。 
 
对本程序的版权声明如免费软件。可自由使用，但严禁用于商业目的。同时请保留所有 
已有的版权信息。 
|; 
(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 "\n 请等候释放对话框数据...") 
               (CONS 2 "应用程序错误:\n %1%") 
               (CONS 3 "本图无\042WALL\042层, 自动处理当前层...") 
               (CONS 4 "\n 请点取欲处理图层的一个物体 <退出>: ") 
               (CONS 5 "\n 无效的选择集, 请重新再试! ") 
               (CONS 6 "\n 对不起, 未发现有效直线! ") 
               (CONS 7 "\n 无效的选择集, 请重新再试! ") 
               (CONS 8 
                     "\n [A/放大 S/缩小 D/对中 F/窗口 G/前一窗口 H/帮助]" 
               ) 
               (CONS 9 "\n 请点取第一角点 [U/回退] <退出> : ") 
               (CONS 10 "\n 请点取第一角点 <退出> : ") 
               (CONS 11 "\n 请点取第二角点 <退出> : ") 
               (CONS 12 "\n 发现\042%1%\042个无效实体, 请重新再试! ") 
               (CONS 13 "\n 选中的直线总数必须是二到四条! ") 
               (CONS 14 "\n 请移去多余的直线 <退出>") 
               (CONS 15 "\n 请加入不足的直线 <退出>") 
               (CONS 16 "\n 框选中两条直线的端点将连接两条直线! ") 
               (CONS 17 "\n 帮助幻灯片未发现! ") 
               (CONS 18 "\n 键入任意键返回! ") 
             ) 
      ) 
      (setq CS:APPMSG 
             (LIST 
               (CONS 0 " Done!") 
               (CONS 1 
                     "\n Waiting for extracting dialog data..." 
               ) 
               (CONS 2 "Application Error:\n %1%") 
               (CONS 
                 3 
                 "No layer \042WALL\042,processing current layer..." 
               ) 
               (CONS 
                 4 
                 "\n Pick an entity on processing layer <Exit>:" 
               ) 
               (CONS 5 
                     "\n Invalid SelectionSet,please retry!" 
               ) 
               (CONS 6 "\n Sorry,no valid lines found!") 
               (CONS 7 
                     "\n Invalid SelectionSet,please retry!" 
               ) 
               (CONS 
                 8 
                 "\n [A/<Zoom 2x>S/<Zoom .5x>D/<Zoom C>F/<Zoom W>G/<Zoom P>H/Help]" 
               ) 
               (CONS 
                 9 
                 "\n Please pick first corner  [Undo] <Exit>:" 
               ) 
               (CONS 10 
                     "\n Please pick first corner <Exit> :" 
               ) 
               (CONS 11 
                     "\n Please pick second corner <Exit> :" 
               ) 
               (CONS 
                 12 
                 "\n Found \042%1%\042 invalid objects,please retry!" 
               ) 
               (CONS 
                 13 
                 "\n The number of selected lines must between 2 to 4!" 
               ) 
               (CONS 14 "\n Please remove some lines <Exit>") 
               (CONS 15 "\n Please add some lines?Exit>") 
               (CONS 
                 16 
                 "\n Window two endpoint will join them by a line!" 
               ) 
               (CONS 17 "\n Help Slide NOT found!") 
               (CONS 18 "\n 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) 
)

zhynt · 发表于 2003-12-20 20:50:15

不实用，说是智能，其实并不智能。

陌生人 · 发表于 2003-12-20 22:45:04

能拿出来还是鼓励!
很长,来不及细细看,请问什么样的直线才符合要求?
测试:
Command: cs
[A/放大 S/缩小 D/对中 F/窗口 G/前一窗口 H/帮助]
请点取第一角点 <退出> :
请点取第二角点 <退出> :
对不起, 未发现有效直线!
[A/放大 S/缩小 D/对中 F/窗口 G/前一窗口 H/帮助]
请点取第一角点 [U/回退] <退出> :
请点取第二角点 <退出> :
对不起, 未发现有效直线!
[A/放大 S/缩小 D/对中 F/窗口 G/前一窗口 H/帮助]
请点取第一角点 [U/回退] <退出> :
T

aeo · 发表于 2003-12-20 23:05:22

做个演示吧.
看反馈好像不好用!

lsjjm · 发表于 2003-12-21 04:30:06

我觉得程序的基本功能是代替或部分代替人工操作. 因此评价一段程序码, 是要看其是否实现这一功能, 当然还要看是否实用, 简捷而提高效率, 否则我们费了很大劲编它干什么?

mmmm · 发表于 2003-12-21 11:53:50

Demonstration

陌生人 · 发表于 2003-12-21 13:10:50

楼上的图想说明什么?我没看明白.Demonstration 是层名么?
晕了

subtlation · 发表于 2003-12-21 13:33:45

我用cad2004试用了，效果倒还可以，但是把我自己的捕捉设置和选择图标的设置全部改变了。这样没办法用啊。总不成每次用完后再把捕捉等设置都改回来吧，这样我还不如直接用cad的命令操作还快些。

mmmm · 发表于 2003-12-21 15:10:43

8楼：
这些代码仅仅是核心代码，变量的操控被去掉了，因为原来写的不好的，你可以自己加你自己常用并熟悉的。在(CS_SETUP)中和程序结束后。
7楼:
程序每次只可以处理2到4条直线，这些直线会被(ssget "c")由用户点取得矩形对角框取得。直线的图层没有限制，也没有判断直线是否在锁定的层上。这些需要人工先判断。
直线数目不符合规定时，程序会提示增加或删除。
demonstration是演示的意思

陌生人 · 发表于 2003-12-21 19:28:35

哦,知道了
原程序好像写的挺长的,似乎这些功能没必要写那么长吧.哈哈.说说而已.
有时间我也写一个

hnfsf · 发表于 2003-12-21 22:43:53

很不错呀，挺好用的！

mmmm · 发表于 2003-12-22 11:22:37

这是我新写的，还没最后完成。
命令：CS和CSSETUP

当有重线时，可以自动清理。操作方法同原来的一样。

coolzhb · 发表于 2003-12-22 12:07:00

最初由 mmmm 发布
[B]这是我新写的，还没最后完成。
命令：CS和CSSETUP

当有重线时，可以自动清理。操作方法同原来的一样。 [/B]

除了当有重线时，可以自动清理外，还有什么不同或改进吗？
最好有像上面那样的演示！

mmmm · 发表于 2003-12-22 12:41:08

暂时没有。参照原来的演示就行。
等这个版本基本完成后，
会加入对圆弧和多线段的支持。

陌生人 · 发表于 2003-12-22 13:13:38

别等了,再等几天我就写出支持所有2d曲线的程序了.
过了周末,现在要忙了 :(

账号		自动登录	找回密码
密码			立即注册

[分享]：矩形裁剪的最智能化工具，源代码（for 14~2004）

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子