IT Knowledge Base

在AutoCAD中，如需要為一個不規則的圖形，找出其邊界，當然可以用人手在四邊邊位畫線，再連起來。

但如果只要一個Lisp程式一個命令也可以做到時，又何樂而不為呢？

;Main program.
(DEFUN C:RC (/ A A1 A2 B C D FLAG I IN J LD LT MIDX MIDY MIDPT DONUT_IN DONUT_OU RD RT X1 Y2 X1 Y2)
(PROMPT "\\nFind boundary of selected object(s). Require no block inside.")
(SETQ LENG "5")
(SETQ DONUT_IN "0.5")
(SETQ DONUT_OU "1")
(GRAPHSCR)
(SETVAR "CMDECHO" 0)
(SETQ LENGH (STRCAT "@" LENG "<0"))
(SETQ LENGV (STRCAT "@" LENG "<90"))
(SETQ A (SSGET))
(SETQ I 0)
(REPEAT (SSLENGTH A)
(SETQ A1 (CDR (ASSOC 0 (ENTGET (SSNAME A I)))))
(IF (= A1 "INSERT")
(PROGN
(ALERT "BLOCK detected.\\nPlease explode it before run this lisp.\\n\\nProgram halt.")
(EXIT)
)
)
(SETQ I (1+ I))
)
(SETQ I 0)
(SETQ B1 (CDR (ASSOC 0 (ENTGET (SSNAME A 0)))))
(REPEAT (SSLENGTH A)
(SETQ B (SSNAME A I))
(SETQ C (ENTGET B))
(SETQ D (CDR (ASSOC 0 C)))
(COND
((= D "LINE")
;Call sub-program RC_LINE.
(RC_LINE C)
)
((= D "ARC")
;Call sub-program RC_ARC.
(RC_ARC C)
)
((= D "CIRCLE")
;Call sub-program RC_CIRCLE.
(RC_CIRCLE C)
)
((= D "LWPOLYLINE")
;Call sub-program RC_LWPOLYLINE.
(RC_LWPOLYLINE C)
)
)
(IF (= I 0)
(PROGN
(SETQ X2 XMAX)
(SETQ X1 XMIN)
(SETQ Y2 YMAX)
(SETQ Y1 YMIN)
)
(PROGN
(SETQ X2 (MAX XMAX X2))
(SETQ X1 (MIN XMIN X1))
(SETQ Y2 (MAX YMAX Y2))
(SETQ Y1 (MIN YMIN Y1))
)
)
(SETQ I (1+ I))
)
(SETQ LD (LIST X1 Y1))
(SETQ LT (LIST X1 Y2))
(SETQ RD (LIST X2 Y1))
(SETQ RT (LIST X2 Y2))
(GRDRAW LD LT 61 1)
(GRDRAW LT RT 61 1)
(GRDRAW RT RD 61 1)
(GRDRAW RD LD 61 1)
(SETQ MIDX (+ (/ (- X2 X1) 2) X1))
(SETQ MIDY (+ (/ (- Y2 Y1) 2) Y1))
(SETQ MIDPT (LIST MIDX MIDY))
(SETQ IN (GETSTRING "Press  to end."))
(SETVAR "OSMODE" 0)
(IF (OR (= IN "E") (= IN "e"))
(COMMAND "REDRAW")
(PROGN
(COMMAND "DONUT" DONUT_IN DONUT_OU MIDPT "")
(COMMAND "DIM" "ORD" MIDPT "X" LENGV "" "EXIT")
(COMMAND "DIM" "ORD" MIDPT "Y" LENGH "" "EXIT")
(COMMAND "REDRAW")
)
)
(SETVAR "OSMODE" 59)
(SETVAR "CMDECHO" 1)
(PRINC)
)

;Sub-program C:RC.
(DEFUN RC_LINE (C)
(SETQ EX (CADR (ASSOC 10 C)))
(SETQ EY (CADDR (ASSOC 10 C)))
(SETQ FX (CADR (ASSOC 11 C)))
(SETQ FY (CADDR (ASSOC 11 C)))
(SETQ XMIN (MIN EX FX))
(SETQ XMAX (MAX EX FX))
(SETQ YMIN (MIN EY FY))
(SETQ YMAX (MAX EY FY))
)

;Sub-program C:RC.
(DEFUN RC_ARC (C / ANGDIFF ANGX1 ANGX2 ANGX3 ANGX4 ANGY1 ANGY2 ANGY3 ANGY4 GCENX GCENY GRAD GSTANG GENANG HPI STX STY)
(SETQ HPI (/ PI 2))
(SETQ GCENX (CADR (ASSOC 10 C)))
(SETQ GCENY (CADDR (ASSOC 10 C)))
(SETQ GRAD (CDR (ASSOC 40 C)))
(SETQ GSTANG (CDR (ASSOC 50 C)))
(SETQ GENANG (CDR (ASSOC 51 C)))
(SETQ ANGDIFF (- GENANG GSTANG))
(SETQ STX (+ (* GRAD (COS GSTANG)) GCENX))
(SETQ STY (+ (* GRAD (SIN GSTANG)) GCENY))
(SETQ ENX (+ (* GRAD (COS GENANG)) GCENX))
(SETQ ENY (+ (* GRAD (SIN GENANG)) GCENY))
(SETQ ANGX1 STX ANGX2 STX ANGX3 STX ANGX4 STX)
(SETQ ANGY1 STY ANGY2 STY ANGY3 STY ANGY4 STY)
(IF (AND (> GSTANG 0) (< GSTANG HPI))
(PROGN
(IF (AND (> GENANG HPI) (< GENANG PI))
(PROGN
(SETQ ANGX1 GCENX)
(SETQ ANGY1 (+ GCENY GRAD))
)
)
(IF (AND (> GENANG PI) (< GENANG (* 3 HPI)))
(PROGN
(SETQ ANGX1 GCENX)
(SETQ ANGY1 (+ GCENY GRAD))
(SETQ ANGX2 (- GCENX GRAD))
(SETQ ANGY2 GCENY)
)
)
(IF (AND (> GENANG (* 3 HPI)) (< GENANG (* 2 PI)))
(PROGN
(SETQ ANGX1 GCENX)
(SETQ ANGY1 (+ GCENY GRAD))
(SETQ ANGX2 (- GCENX GRAD))
(SETQ ANGY2 GCENY)
(SETQ ANGX3 GCENX)
(SETQ ANGY3 (- GCENY GRAD))
)
)
(IF (AND (> GENANG 0) (< GENANG HPI) (< ANGDIFF 0))
(PROGN
(SETQ ANGX1 GCENX)
(SETQ ANGY1 (+ GCENY GRAD))
(SETQ ANGX2 (- GCENX GRAD))
(SETQ ANGY2 GCENY)
(SETQ ANGX3 GCENX)
(SETQ ANGY3 (- GCENY GRAD))
(SETQ ANGX4 (+ GCENX GRAD))
(SETQ ANGY4 GCENY)
)
)
)
)
(IF (AND (> GSTANG HPI) (< GSTANG PI))
(PROGN
(IF (AND (> GENANG PI) (< GENANG (* 3 HPI)))
(PROGN
(SETQ ANGX1 (- GCENX GRAD))
(SETQ ANGY1 GCENY)
)
)
(IF (AND (> GENANG (* 3 HPI)) (< GENANG (* 2 PI)))
(PROGN
(SETQ ANGX1 (- GCENX GRAD))
(SETQ ANGY1 GCENY)
(SETQ ANGX2 GCENX)
(SETQ ANGY2 (- GCENY GRAD))
)
)
(IF (AND (> GENANG 0) (< GENANG HPI))
(PROGN
(SETQ ANGX1 (- GCENX GRAD))
(SETQ ANGY1 GCENY)
(SETQ ANGX2 GCENX)
(SETQ ANGY2 (- GCENY GRAD))
(SETQ ANGX3 (+ GCENX GRAD))
(SETQ ANGY3 GCENY)
)
)
(IF (AND (> GENANG HPI) (< GENANG PI) (< ANGDIFF 0))
(PROGN
(SETQ ANGX1 (- GCENX GRAD))
(SETQ ANGY1 GCENY)
(SETQ ANGX2 GCENX)
(SETQ ANGY2 (- GCENY GRAD))
(SETQ ANGX3 (+ GCENX GRAD))
(SETQ ANGY3 GCENY)
(SETQ ANGX4 GCENX)
(SETQ ANGY4 (+ GCENY GRAD))
)
)
)
)
(IF (AND (> GSTANG PI) (< GSTANG (* 3 HPI)))
(PROGN
(IF (AND (> GENANG (* 3 HPI)) (< GENANG (* 2 PI)))
(PROGN
(SETQ ANGX1 GCENX)
(SETQ ANGY1 (- GCENY GRAD))
)
)
(IF (AND (> GENANG 0) (< GENANG HPI))
(PROGN
(SETQ ANGX1 GCENX)
(SETQ ANGY1 (- GCENY GRAD))
(SETQ ANGX2 (+ GCENX GRAD))
(SETQ ANGY2 GCENY)
)
)
(IF (AND (> GENANG HPI) (< GENANG PI))
(PROGN
(SETQ ANGX1 GCENX)
(SETQ ANGY1 (- GCENY GRAD))
(SETQ ANGX2 (+ GCENX GRAD))
(SETQ ANGY2 GCENY)
(SETQ ANGX3 GCENX)
(SETQ ANGY3 (+ GCENY GRAD))
)
)
(IF (AND (> GENANG PI) (< GENANG (* 3 HPI)) (< ANGDIFF 0))
(PROGN
(SETQ ANGX1 GCENX)
(SETQ ANGY1 (- GCENY GRAD))
(SETQ ANGX2 (+ GCENX GRAD))
(SETQ ANGY2 GCENY)
(SETQ ANGX3 GCENX)
(SETQ ANGY3 (+ GCENY GRAD))
(SETQ ANGX4 (+ GCENX GRAD))
(SETQ ANGY4 GCENY)
)
)
)
)
(IF (AND (> GSTANG (* 3 HPI)) (< GSTANG (* 2 PI)))
(PROGN
(IF (AND (> GENANG 0) (< GENANG HPI))
(PROGN
(SETQ ANGX1 (+ GCENX GRAD))
(SETQ ANGY1 GCENY)
)
)
(IF (AND (> GENANG HPI) (< GENANG PI))
(PROGN
(SETQ ANGX1 (+ GCENX GRAD))
(SETQ ANGY1 GCENY)
(SETQ ANGX2 GCENX)
(SETQ ANGY2 (+ GCENY GRAD))
)
)
(IF (AND (> GENANG PI) (< GENANG (* 3 HPI)))
(PROGN
(SETQ ANGX1 (+ GCENX GRAD))
(SETQ ANGY1 GCENY)
(SETQ ANGX2 GCENX)
(SETQ ANGY2 (+ GCENY GRAD))
(SETQ ANGX3 (+ GCENX GRAD))
(SETQ ANGY3 GCENY)
)
)
(IF (AND (> GENANG (* 3 HPI)) (< GENANG (* 2 PI)) (< ANGDIFF 0))
(PROGN
(SETQ ANGX1 (+ GCENX GRAD))
(SETQ ANGY1 GCENY)
(SETQ ANGX2 GCENX)
(SETQ ANGY2 (+ GCENY GRAD))
(SETQ ANGX3 (+ GCENX GRAD))
(SETQ ANGY3 GCENY)
(SETQ ANGX4 GCENX)
(SETQ ANGY4 (- GCENY GRAD))
)
)
)
)
(SETQ XMIN (MIN ANGX1 ANGX2 ANGX3 ANGX4 STX ENX))
(SETQ XMAX (MAX ANGX1 ANGX2 ANGX3 ANGX4 STX ENX))
(SETQ YMIN (MIN ANGY1 ANGY2 ANGY3 ANGY4 STY ENY))
(SETQ YMAX (MAX ANGY1 ANGY2 ANGY3 ANGY4 STY ENY))
)

;Sub-program C:RC.
(DEFUN RC_CIRCLE (C / KCENX KCENY KRAD CMAXX CMINX CMAXY CMINY)
(SETQ KCENX (CADR (ASSOC 10 C)))
(SETQ KCENY (CADDR (ASSOC 10 C)))
(SETQ KRAD (CDR (ASSOC 40 C)))
(SETQ XMAX (+ KCENX KRAD))
(SETQ XMIN (- KCENX KRAD))
(SETQ YMAX (+ KCENY KRAD))
(SETQ YMIN (- KCENY KRAD))
)

;Sub-program C:RC.
(DEFUN RC_LWPOLYLINE (C / N N1 O P Q)
(SETQ EXC (CDR (ASSOC -1 C)))
(COMMAND "EXPLODE" EXC)
(SETQ N (SSGET "P"))
(SETQ N1 0)
(REPEAT (SSLENGTH N)
(SETQ O (SSNAME N N1))
(SETQ P (ENTGET O))
(SETQ Q (CDR (ASSOC 0 P)))
(COND
((= Q "LINE")
;Call sub-program RC_LINE.
(RC_LINE P)
)
((= Q "ARC")
;Call sub-program RC_ARC.
(RC_ARC P)
)
)
(IF (= N1 0)
(PROGN
(SETQ X12 XMAX)
(SETQ X11 XMIN)
(SETQ Y12 YMAX)
(SETQ Y11 YMIN)
)
(PROGN
(SETQ X12 (MAX XMAX X12))
(SETQ X11 (MIN XMIN X11))
(SETQ Y12 (MAX YMAX Y12))
(SETQ Y11 (MIN YMIN Y11))
)
)
(SETQ N1 (1+ N1))
)
(COMMAND "PEDIT" N "" "J" N "" "")
(SETQ XMAX X12)
(SETQ XMIN X11)
(SETQ YMAX Y12)
(SETQ YMIN Y11)
)