[LISP程序]：利用两点插图框

killer9806

(defun c:er (/ point1 point2 pt_x1 pt_x2 pt_y1 pt-y2
             ptmid_x ptmid_y mid mult_x mult_y mult_xy inpoint_x inpoint_y inpoint_xy)
  (princ "\n插入图框——枫之钣金制作室")
  (setvar "pickfirst" 0)
  (setvar "cmdecho" 0)
  (setvar "attdia" 1)
                                        ;选取矩形状
  (setq        point1        (getpoint "\n输入插入点:")
        point2        (getcorner point1 "\n输入对角点:")
        pt_x1        (car point1)
        pt_y1        (cadr point1)
        pt_x2        (car point2)
        pt_y2        (cadr point2)
        ptmid_x        (ABS (- pt_x1 pt_x2))
        ptmid_y        (ABS (- pt_y1 pt_y2))
  )

                                        ;获取矩形状的中心
  (COND
    ((> pt_x1 pt_x2)
     (cond
       ((> pt_y1 pt_y2)
        (setq mid_x (+ pt_x2 (/ ptmid_x 2))
              mid_y (+ pt_y2 (/ ptmid_y 2))
              mid   (list mid_x mid_y)
        )
       )
       ((< pt_y1 pt_y2)
        (setq mid_x (+ pt_x2 (/ ptmid_x 2))
              mid_y (+ pt_y1 (/ ptmid_y 2))
              mid   (list mid_x mid_y)
        )
       )
       (T (princ "\n选取错误"))
     )
    )
    ((< pt_x1 pt_x2)
     (cond
       ((> pt_y1 pt_y2)
        (setq mid_x (+ pt_x1 (/ ptmid_x 2))
              mid_y (+ pt_y2 (/ ptmid_y 2))
              mid   (list mid_x mid_y)
        )
        (princ)
       )
       ((< pt_y1 pt_y2)
        (setq mid_x (+ pt_x1 (/ ptmid_x 2))
              mid_y (+ pt_y1 (/ ptmid_y 2))
              mid   (list mid_x mid_y)
        )
       )
       (T (princ "\n选取错误"))
     )
    )
    (T (princ "\n选取错误"))
  )

                                        ;根据矩形的形状判别与图块的相应比例
  (setq        mult_x (rtos (/ ptmid_x 280.0) 2 2)
        mult_y (rtos (/ ptmid_y 160.00) 2 2)
  )
  (cond
    ((or (/= mult_x "0.00") (/= mult_y "0.00"))
     (cond
       ((> mult_x mult_y)
        (setq mult_xy mult_x)
       )
       ((< mult_x mult_y)
        (setq mult_xy mult_y)
       )
       ((= mult_x mult_y)
        (setq mult_xy mult_x)
       )
       (T (princ "\n选取错误！"))
     )
    )
    ((and (= mult_x "0.00") (= mult_y "0.00"))
     (setq mult_xy "0.01")
    )
    (T (princ "选取错误"))
  )

                                        ;获取插入点，并插入图块
  (setq        inpoint_x  (- mid_x (* (read mult_xy) (+ 210 50)))
        inpoint_y  (- mid_y (* (read mult_xy) 160))
        inpoint_xy (list inpoint_x inpoint_y)
  )
;  "f:/cad/block/a3.dwg"为图框的图

  (command "-insert"
           "f:/cad/block/a3.dwg"
           (princ inpoint_xy)
           (princ mult_xy)
           (princ mult_xy)
           "0"
  )
  (princ)
  (princ)
  (princ "\n图框插入成功!!!!!")
  (setvar "cmdecho" 1)
  (setvar "pickfirst" 1)
  (setvar "attdia" 0)
  (PRINC)
)