[编程交流] bl基点之间的PLINE

;;;
;;; LUMTEST.LSP
;;;
;;;
;;;
;;;
;;; ***** ERROR HANDLER *****
(defun RLERR (S)
 (if (/= S "Function cancelled")      ; If an error (such as CTRL-C)
     (princ (strcat "\nError: " S))   ; occurs while this command is
 )
 (command)
 (command "undo" "end")
 (command "undo" 1)                   ; active...
 (setq *error* OLDERR)                ; Restore previous settings    
 (setvar "clayer" PL)
 (setvar "cmdecho" PC)
 (princ)
)
;;; ***** MAIN PROGRAM ***** 
(DEFUN C:LUMTEST (/ OLDERR BL BN CD IM LC OM PC PD PL PO PR P1 P2 p4 p5 p6 YP1 YP2 XP1 XP2 ly lx ob sc sr
                 tx1 tx2 tx3 ty1 ty2 ty3 na lp1 lp2 lp3 lp4 ln1 ln2 lc lr)
 (setq PC (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (command "undo" "begin")
 (setq SCALE (getvar "USERR3")
       PR (getvar "regenmode")
       PO (getvar "osmode")
       PL (getvar "clayer")
       OLDERR *error*
       *error* RLERR
 )
 (setvar "clayer" "lighting")
 (setvar "regenmode" 0)
 (setvar "osmode" 32)
 (setq P1 (getpoint " Pick bottom left corner of room: "))   ;RETURNS: (96795.6 -7088.0 0.0)
 (setq P2 (getcorner P1 " Pick top right corner of room: ")) ;RETURNS: (138716.0 16469.7 0.0)
;;;
;;; From points P1 and P2 calculate the x-distance and y-distance.
;;;
 (setq XP1 (car P1))                                         ;RETURNS: 96795.6 (P1 x-coordinate)
 (setq XP2 (car P2))                                         ;RETURNS: 138716.0 (P2 x-coordinate)
 (setq YP1 (cadr P1))                                        ;RETURNS: -7088.0 (P1 y-coordinate)
 (setq YP2 (cadr P2))                                        ;RETURNS: 16469.7 (P2 y-coordinate)
 (setq LX (- XP2 XP1))                                       ;RETURNS: 41920.9 (calc x distance)
 (setq LY  (- YP2 YP1))                                      ;RETURNS: 23557.7 (calc y distance)
;;;
;;; X-distance divided by number of lights gives column spacing.
;;; Y-distance divided by number of lights gives row spacing.
;;;
 (setq XVAL (getint "\nNumber of Lights across: "))
 (setq YVAL (getint "\nNumber of Lights down: "))
 (setq SR (/ LX XVAL))                                       ;RETURNS: 6986.81 (x-dist div. by no. lights)
 (setq SC (/ LY YVAL))                                       ;RETURNS: 7852.55m (y-dist div. by no. lights)
 (setq SR2 (/ SR 2))                                         ;RETURNS: 3493.41 (x column spacing)
 (setq SC2 (/ SC 2))                                         ;RETURNS: 3926.28 (y column spacing)
 (setq P3 (list (+ (car P1) SR2) (+ (cadr P1) SC2)))         ;RETURNS: (100289.0 -3161.72) (calculated point to start array)
;  (command "point" P3)
 (command "-insert" "L-Fluoro" P3 "100" "100" pause)               
 (progn
   (cond
     ((and (< XVAL 2) (>= YVAL 2))
       (command "array" "l" "" "rectangular" YVAL XVAL SC)
     )
     ((and (< YVAL 2) (>= XVAL 2))
       (command "array" "l" "" "rectangular" YVAL XVAL SR)
     )
     ((and (>= XVAL 2) (>= YVAL 2))
       (command "array" "l" "" "rectangular" YVAL XVAL SC SR)
     )
   )
 )
;;;   **** Restore previous settings ****
 (setq *error* olderr)            
 (setvar "clayer" PL)
 (setvar "osmode" PO)
 (setvar "regenmode" PR)
 (command "undo" "end")
 (setvar "cmdecho" PC)
 (princ)
)

(command "_PLINE")
(foreach thePoint listOfPoints
(command thePoint)
)
(command  "")

(DEFUN C:LUMTEST (/ ;OLDERR BL BN CD IM LC OM PC PD PL PO PR P1 P2 p4 p5 p6 YP1 YP2 XP1 XP2 ly lx ob sc sr
                 ;tx1 tx2 tx3 ty1 ty2 ty3 na lp1 lp2 lp3 lp4 ln1 ln2 lc lr
                 )
[color="blue"](if (and [/color]
 (setq P1 (getpoint " Pick First corner of room: "))   
 (setq P2 (getcorner P1 " Pick Other corner of room: ")))
[color="blue"]  (progn
          (setq p p1
                p1 (list (setq XP1 (min (car p1)(car p2)))
                         (setq YP1 (min (cadr p1)(cadr p2))))
                p2 (list (setq XP2 (max (car p)(car p2)))
                         (setq YP2 (max (cadr p)(cadr p2)))))[/color]
  (setq LX (- XP2 XP1))                                      
  (setq LY  (- YP2 YP1))
        [color="blue"] (initget 7)  [/color]
  (setq XVAL (getint "\nNumber of Lights across: "))
        [color="blue"] (initget 7)  [/color]
  (setq YVAL (getint "\nNumber of Lights down: "))
  (setq SR (/ LX XVAL))                                       
  (setq SC (/ LY YVAL))                                     
  (setq SR2 (/ SR 2))                                         
  (setq SC2 (/ SC 2))                                         
  (setq P3 (list (+ (car P1) SR2) (+ (cadr P1) SC2)))         
  (command "-insert" "L-Fluoro" "_non" P3 "100" "100" pause)
        [color="blue"]  (setq  el (entlast) s2 (ssadd el)
                ) [/color]
  (command "array" "l" "" "rectangular" YVAL XVAL SC SR)
[color="blue"]  (while (setq el (entnext el))
                    (ssadd el s2)
                )
  (setq r 1 ptData nil)
        (repeat (setq i (sslength s2))
          (setq pts (cons (cdr (assoc 10 (entget (ssname s2 (setq i (1- i)))))) pts))
          (if (= (length pts) Yval)
            (setq ptData (cons (if (zerop r)
                                 (reverse pts)
                                 pts)
                               ptData)
                  pts    nil
                  r      (boole 6 1 r))))
(command "Pline")
(foreach pt (apply 'append ptdata)
  (command  "_non" pt))
(command "")[/color]
  )
 )
 (princ)
 )