关于长宽矩形问题

xiao88gang

论谈上找的画矩形的代码，觉得很好用，唯一不足的就是，能不能把起点和终点直接改为插入点，以矩形的中心为基准点。
哪位大侠给改一下代码，先谢谢啦。


(defun c:FF (/ d h p1 p2 p3 p1x p1y)
        (setq d (getdist"\n矩形长度:")  h (getdist"\n矩形高度:"))
        (while
                (setq        p1 (getpoint"\n选起点:") p2 (getcorner p1"\n选终点:")
                        p1x (car p1)
                        p1y (cadr p1)
                        ang (angle P1 P2))
                (cond
                        ((and (>= ang (* 0 pi)) (< ang (* 0.5 pi))) (setq p3 (list (+ p1x d) (+ p1y h))))
                        ((and (>= ang (* 0.5 pi)) (< ang (* 1 pi))) (setq p3 (list (- p1x d) (+ p1y h))))
                        ((and (>= ang (* 1 pi)) (< ang (* 1.5 pi))) (setq p3 (list (- p1x d) (- p1y h))))
                        ((and (>= ang (* 1.5 pi)) (< ang (* 2 pi))) (setq p3 (list (+ p1x d) (- p1y h))))
                )
                p3 (command "RECTANG" "non" p1 "non" p3))
        (princ)
)

kkq0305

厉害了，这个解决方案。

xiao88gang

kkq0305 发表于 2021-9-14 21:48
厉害了，这个解决方案。

很不错的，就是这样的效果，改了哪里？

start4444

(defun c:tt5 (/ d h key p1 p1x p1y p2 p3)
        (setq d (getdist"\n矩形长度:")  h (getdist"\n矩形高度:"))
        (while
                (setq p1 (getpoint"\n选取矩形中心点:"))
                (setq p1x (car p1) p1y (cadr p1) p2 (list (- p1x (* 0.5 d)) (+ p1y (* 0.5 h))) p3 (list (+ p1x (* 0.5 d)) (- p1y (* 0.5 h))))
                (command "RECTANG" "non" p2 "non" p3)
                (setq key (getstring  "是否旋转？[是(Y)/否(空格)]:"))
                (if (= key "y") (command "ROTATE" "l" "" "non" p1 90))
        )
        (princ)
)

kkq0305

(defun c:tt ()
  (setq        d (getdist "\n矩形长度:")
        h (getdist "\n矩形高度:")
  )
  (while (setq pt (getpoint "\n输入矩形中心："))
    (setq loop t)
    (while loop
      (setq code (grread t 8))
      (cond ((= (car code) 5)
             (redraw)
             (makt pt (cadr code) d h nil)
            )
            ((= (car code) 3)
             (redraw)
             (makt pt (cadr code) d h nil)
             (setq loop nil)
            )
      )
    )
    (redraw)
    (makt pt (cadr code) d h t)
  )
  (princ)
)
(defun makt (pt1 pt2 d h key)
  (if (or (< (* 0.25 pi) (angle pt1 pt2) (* 0.75 pi))
          (< (* 1.25 pi) (angle pt1 pt2) (* 1.75 pi))
      )
    (setq d0 h
          h0 d
    )
    (setq d0 d
          h0 h
    )
  )
  (if key
    (entmake
      (list
        '(0 . "LWPOLYLINE")
        '(100 . "AcDbEntity")
        '(100 . "AcDbPolyline")
        '(90 . 4)
        '(70 . 1)
        '(62 . 3)
        (cons 10
              (mapcar '+ (list (- (* 0.5 d0)) (- (* 0.5 h0))) pt1)
        )
        (cons 10
              (mapcar '+ (list (+ (* 0.5 d0)) (- (* 0.5 h0))) pt1)
        )
        (cons 10
              (mapcar '+ (list (+ (* 0.5 d0)) (+ (* 0.5 h0))) pt1)
        )
        (cons 10
              (mapcar '+ (list (- (* 0.5 d0)) (+ (* 0.5 h0))) pt1)
        )
      )
    )
    (grvecs
      (list 1
            pt1
            pt2
            1
            (mapcar '+ (list (- (* 0.5 d0)) (- (* 0.5 h0))) pt1)
            (mapcar '+ (list (+ (* 0.5 d0)) (- (* 0.5 h0))) pt1)
            1
            (mapcar '+ (list (+ (* 0.5 d0)) (- (* 0.5 h0))) pt1)
            (mapcar '+ (list (+ (* 0.5 d0)) (+ (* 0.5 h0))) pt1)
            1
            (mapcar '+ (list (+ (* 0.5 d0)) (+ (* 0.5 h0))) pt1)
            (mapcar '+ (list (- (* 0.5 d0)) (+ (* 0.5 h0))) pt1)
            1
            (mapcar '+ (list (- (* 0.5 d0)) (+ (* 0.5 h0))) pt1)
            (mapcar '+ (list (- (* 0.5 d0)) (- (* 0.5 h0))) pt1)
      )
    )
  )
)

趣意人生

回复收藏学习！

alexmai

画矩形，还是默认的好，(command "RECTANG" pause "d")