[综合讨论] 投影几何体

 
; LSQ.LSP - "LINE SKEW" Connects SKEW lines with the shortest connector
;               From original code (c)1992, Mitchell A. Wawzonek
;   Mitchell A. Wawzonek, P.Eng., Professor
;   School of Engineering Technology
;   Conestoga College
;   299 Doon Valley Drive
;   Kitchener, ON   N2G 4M4
;   Canada
;
;   FINDS THE COMMON PERPENDICULAR 
;   BETWEEN 2 SKEW LINES
;
; 5-26-06  Added error handling and useability in any UCS.
;          Also declared local variables.
;
(defun lsq_error (msg)
(setq *error* sys_error)
(command "UCS" "R" "SYSUCS")
(command "UCS" "D" "SYSUCS")
(setvar "OSMODE" OLDSNAP)
(setvar "CMDECHO" 1)
(redraw)
(princ)
)
(defun C:LSQ (/ E1 E2 P1 P2 P3 P4 X1 X2 X3 X4 Y1 Y2 Y3 Y4 
               Z1 Z2 Z3 Z4 A D B C F CA SA ANG R1 R P5 P6 DS )
               
  (setq sys_error *error*)
  (setq *error* lsq_error)
  (setvar "CMDECHO" 0)
  (setq OLDSNAP (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (command "UCS" "S" "SYSUCS")
  (command "UCS" "")
  (setq E1 nil E2 nil)
     (while (null E1)
        (setq E1 (entsel "\nLine 1:"))
        (if E1
           (progn
              (setq E1 (car E1))
              (redraw E1 3)
              (if (/= (cdr (assoc 0 (entget E1))) "LINE")
                 (progn
                    (prompt "\nEntity is a ")
                    (princ (cdr (assoc 0 (entget E1))))
                    (princ ". Select a LINE")
                    (setq E1 nil)
                  )
               )
            )
        )
     ) ;endwhile
     (while (null E2)
        (setq E2 (entsel "\nLine 2:"))
        (if E2
           (progn
              (setq E2 (car E2))
              (if (/= (cdr (assoc 0 (entget E2))) "LINE")
                 (progn
                    (prompt "\nEntity is a ")
                    (princ (cdr (assoc 0 (entget E2))))
                    (princ ". Select a LINE")
                    (setq E2 nil)
                  )
               )
            )
        )
     ) ;endwhile
     (setq P1 (cdr (assoc 10 (entget E1)))) ; start point line 1
     (setq P2 (cdr (assoc 11 (entget E1)))) ; end point line 1
     (setq P3 (cdr (assoc 10 (entget E2)))) ; start point line 2
     (setq P4 (cdr (assoc 11 (entget E2)))) ; end point line 2
     (setq X1 (car P1) Y1 (cadr P1) Z1 (caddr P1))  ; components of P1
     (setq X2 (car P2) Y2 (cadr P2) Z2 (caddr P2))  ;   "   "   "   P2
     (setq X3 (car P3) Y3 (cadr P3) Z3 (caddr P3))  ;   "   "   "   P3
     (setq X4 (car P4) Y4 (cadr P4) Z4 (caddr P4))  ;   "   "   "   P4
     (setq A (+ (* (- X2 X1)(- X1 X3)) (* (- Y2 Y1)(- Y1 Y3)) (* (- Z2 Z1)(- Z1 Z3))))
     (setq D (+ (* (- X4 X3)(- X1 X3)) (* (- Y4 Y3)(- Y1 Y3)) (* (- Z4 Z3)(- Z1 Z3))))
     (setq B (+ (* (- X2 X1)(- X2 X1)) (* (- Y2 Y1)(- Y2 Y1)) (* (- Z2 Z1)(- Z2 Z1))))
     (setq C (+ (* (- X2 X1)(- X4 X3)) (* (- Y2 Y1)(- Y4 Y3)) (* (- Z2 Z1)(- Z4 Z3))))
     (setq F (+ (* (- X4 X3)(- X4 X3)) (* (- Y4 Y3)(- Y4 Y3)) (* (- Z4 Z3)(- Z4 Z3))))
     (setq CA (ABS (/ C (* (SQRT B)(SQRT F))))) ;Cosine CA=1 
     (setq SA (SQRT (ABS (- 1 (* CA CA))))) ;Sine SA=0
     (setq ANG (ATAN SA CA))
     (princ (strcat "\nAngle = " (angtos ANG 0 4)))
     (IF (< ANG 0.000005) 
     (princ "\nLines are parallel - No connector\n")
        (progn
           (setq R1 (/ (- (* A C) (* B D)) (- (* C C) (* B F))))
           (setq R (/ (- (* C R1) A) B))
           ; connector end pnts
           (setq P5 (LIST (+ X1 (* (- X2 X1) R))(+ Y1 (* (- Y2 Y1) R))(+ Z1 (* (- Z2 Z1) R))))  
           (setq P6 (LIST (+ X3 (* (- X4 X3) R1))(+ Y3 (* (- Y4 Y3) R1))(+ Z3 (* (- Z4 Z3) R1))))
           (setq DS (distance P5 P6)) ; connector length
           (if (or (< 1 R) (< 1 R1))
              (princ " * * * CAUTION: Connector past end of Line 1 or 2"))
           (if (or (< R 0) (< R1 0))
              (princ " * * * CAUTION: Connector past end of Line 1 or 2"))
           (princ (strcat "\nConnector length = " (rtos DS)))
           (if (> DS 0.00000000001) 
              (command ".LINE" P5 P6 "")
              (princ  "\nLines intersect - no connection")
           )
        );endprogn
     );endif
     (setq *error* sys_error)
     (command "UCS" "R" "SYSUCS")
     (command "UCS" "D" "SYSUCS")
     (setvar "OSMODE" OLDSNAP)
     (setvar "CMDECHO" 1)
     (princ "\r")
     (redraw)
     (princ)
)