[编程交流] 使用Perpen绘制矩形

(defun c:Test (/ s ss a b c d ins lst)
 ;;                 Tharwat - Date: 21.June.2016                ;;
 ;; Draw closed LWpolyline from the two selected        ;;
 ;; LWpolylines and they must be straight.                ;;
 (defun _straight-p (e / l q a)
   (setq l (mapcar 'cdr
                   (vl-remove-if-not
                     '(lambda (p) (= (car p) 10))
                     (entget (ssname e 0))
                     )
                   )
         q (car l)
         a (angle q (cadr l))
         )
   (apply
     'and
     (mapcar
       '(lambda (pt) (and (equal (angle q pt) a 1e-4) (setq q pt)))
       (cdr l)
       )
     )
   )
 (princ "\nSelect 1st LWpolyline :")
 (if (and (setq s (ssget "_+.:S:E" '((0 . "LWPOLYLINE"))))
          (_straight-p s)
          (princ "\nSelect 2nd LWpolyline :")
          (setq ss (ssget "_+.:S:E" '((0 . "LWPOLYLINE"))))
          (_straight-p ss)
          (setq a (vlax-curve-getstartpoint (ssname s 0))
                b (vlax-curve-getendpoint (ssname s 0))
                c (vlax-curve-getstartpoint (ssname ss 0))
                d (vlax-curve-getendpoint (ssname ss 0))
                )
          (setq ins (inters a b c d))
          )
   (progn
     (mapcar '(lambda (j k)
                (setq lst (cons (list (polar a j k)
                                      (polar b j k)
                                      )
                                lst
                                )
                      )
                )
             (list (angle d c) (angle c d))
             (list (distance ins c) (distance ins d))
             )
     (setq lst (apply 'append lst))
     (entmake (list '(0 . "LWPOLYLINE")
                    '(100 . "AcDbEntity")
                    '(100 . "AcDbPolyline")
                    '(90 . 4)
                    '(70 . 1)
                    (cons 10 (car lst))
                    (cons 10 (caddr lst))
                    (cons 10 (last lst))
                    (cons 10 (cadr lst))
                    )
              )
     )
   (princ "\nLWpolylines must be straight and crossed !")
   )
 (princ)
 )(vl-load-com)

(defun c:myrect ( / int pl1 pl2 pt1 pt2 pt3 pt4 )
   (if (and (setq pl1 (ssget "_+.:E:S" '((0 . "LWPOLYLINE") (90 . 2))))
            (setq pl2 (ssget "_+.:E:S" '((0 . "LWPOLYLINE") (90 . 2))))
       )
       (if (setq pl1 (entget (ssname pl1 0))
                 pl2 (entget (ssname pl2 0))
                 pt1 (cdr (assoc 10 pl1))
                 pt2 (cdr (assoc 10 (reverse pl1)))
                 pt3 (cdr (assoc 10 pl2))
                 pt4 (cdr (assoc 10 (reverse pl2)))
                 int (inters pt1 pt2 pt3 pt4)
           )
           (entmake
               (list
                  '(000 . "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbPolyline")
                  '(090 . 4)
                  '(070 . 1)
                   (cons 10 (mapcar '+ pt1 (mapcar '- pt3 int)))
                   (cons 10 (mapcar '+ pt1 (mapcar '- pt4 int)))
                   (cons 10 (mapcar '+ pt2 (mapcar '- pt4 int)))
                   (cons 10 (mapcar '+ pt2 (mapcar '- pt3 int)))
               )
           )
           (princ "\nLines do not intersect.")
       )
   )
   (princ)
)