[编程交流] 矩形lisp。帮个小忙！

(defun c:BX (/ foo _dist p1 p2 p3 ang)
 ;; Draw rectangle based on 2 or 3 picked points
 ;; Alan J. Thompson, 07.26.10
 (defun foo (l)
   (entmake
     (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 4) (70 . 129))
             (mapcar (function (lambda (p) (cons 10 (reverse (cdr (reverse (trans p 1 0))))))) l)
     )
   )
 )
 (defun _dist (a b) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))
 (if (and (setq p1 (getpoint "\nSpecify first point: "))
          (setq p2 (getpoint p1 "\nSpecify second point: "))
          (not (grdraw p1 p2 3 1))
     )
   (if (setq p3 (initget 0 "Left Right")
             p3 (getpoint p2 "\nSpecify third point or Square box or [Left/Right]: ")
       )
     (cond ((vl-consp p3) (foo (list p1 p2 p3 (polar p3 (angle p2 p1) (_dist p1 p2)))))
           ((eq (type p3) 'STR)
            (cond
              ((eq p3 "Left") (setq ang (+ (/ pi 2.) (angle p1 p2))))
              ((eq p3 "Right") (setq ang (+ (* pi 1.5) (angle p1 p2))))
            )
            (foo (list p1 p2 (polar p2 ang (_dist p1 p2)) (polar p1 ang (_dist p1 p2))))
           )
     )
   )
 )
 (redraw)
 (princ)
)

(defun c:RX (/ p1 p2 p3 l1 l2 l3 l4 pea)
 (setq p1 (getpoint "\nPick first point: ") p1 (trans p1 1 0))
 (setq p2 (getpoint (trans p1 0 1) "\nPick second point: ") p2 (trans p2 1 0))
 (setq p3 (getpoint "\nPick third point: "))
 (setq l1 (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2))))
 (command "_.offset" "t" l1 p3 "")
 (setq l2 (entlast))
 (setq l3 (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 (cdr (assoc 10 (entget l2)))))))
 (setq l4 (entmakex (list '(0 . "LINE") (cons 10 p2) (cons 11 (cdr (assoc 11 (entget l2)))))))
 (setq pea (getvar 'peditaccept))
 (setvar 'peditaccept 1)
 (command "_.pedit" l1 "j" l1 l2 l3 l4 "" "")
 (setvar 'peditaccept pea)
 (princ)
)

(defun c:test (/ p1 p2 p3 p4 p5 p6)
 (initget 1)
 (setq p1 (getpoint "\nPoint 1:   ")))
 (initget 1)
 (setq p2 (getpoint p1 "\n2nd Point:   "))
 (initget 1)
 (setq p3 (getpoint p2 "\Opposing edge Point:   "))
 (if (setq p4 (inters p1 p2 p3 (polar p3 (+ (angle p1 p2) (* pi 0.5)) 1) nil))
     (setq p5 (polar p1 (+ (angle p1 p2) (* pi 0.5)) (distance p1 p4)) 
           p6 (polar p2 (+ (angle p1 p2) (* pi 0.5)) (distance p1 p4)))
          
 (and p1 p2 p5 p6
(entmake (list (cons 0 "LINE")(cons 10 p1)(cons 11 p2)))          
(entmake (list (cons 0 "LINE")(cons 10 p1)(cons 11 p5)))          
(entmake (list (cons 0 "LINE")(cons 10 p2)(cons 11 p6)))          
(entmake (list (cons 0 "LINE")(cons 10 p5)(cons 11 p6)))          
 
 (prin1))         

(defun c:test (/ p1 p2 p3 p4 p5 p6)
  (initget 1)
  (setq p1 (getpoint "\nPoint 1:   "))
  (initget 1)
  (setq p2 (getpoint p1 "\n2nd Point:   "))
  (initget 1)
  (setq p3 (getpoint p2 "\Opposing edge Point:   "))
  (if (setq p4 (inters p1 p2 p3 (polar p3 (+ (angle p1 p2) (* pi 0.5)) 1) nil))
      (setq p5 (polar p1 (angle p4 p3) (distance p4 p3)) 
            p6 (polar p2 (angle p4 p3) (distance p4 p3)) 
      )
  )
  (and p1 p2 p5 p6
       (entmake
           (list
               (cons 0 "LWPOLYLINE")
               (cons 100 "AcDbEntity")
               (cons 100 "AcDbPolyline")
               (cons 90 4)
               (cons 70 1) 
               (cons 10 p1) 
               (cons 10 p2)
               (cons 10 p6)
               (cons 10 p5)
           ) 
       )
   )
   (princ)
)