[求助]：谁能帮我编一个矩形标注程序谢谢见图(并能实现图上标注的二个功能)

xxming

谁能帮我编一个矩形标注程序谢谢见图(并能实现图上标注的二个功能)

xyp1964

上回给你写了个同时画两个矩形标注的程序，自己改改就行了。

xxming

请你给我编一个吧，能实现上面二个功能。

xyp1964

这种标注没什么用！
[php]
(defun c:test ()
  (setq        pt1  (getpoint "\n引出点 : ")
        pt2  (getpoint pt1 "\n右下标注点 : ")
        ang  (@ureal 1 "" "\n角度" ang)
        ang1 (+ (angle pt1 pt2) (* (/ ang pi) 180))
        pt3  (inters pt2 (polar pt2 0 100) pt1 (polar pt1 ang1 100) nil)
        pt4  (polar pt3 (* pi 1.5) 2000)
        pt5  (_midp pt2 pt4)
        txt  (setq txt1 (@ustr 1 "\n输入文本" txt1 nil))
  )
  (command "line" pt1 pt2 "")
  (command "line" pt1 pt3 "")
  (command "RECTANG" pt2 pt4)
  (command "_style" "汉字" "宋体" "0" "1" "0" "" "")
  (command "text" "j" "mc" pt5 "500" "0" txt)
  (princ)
)
(defun @ureal (bit kwd msg def / inp)
  (if def
    (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
          bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
  )
  (initget bit kwd)
  (setq inp (getreal msg))
  (if inp
    inp
    def
  )
)
(defun @ustr (bit msg def spflag / inp nval)
  (if (and def (/= def ""))
    (setq msg (strcat "\n" msg "<" def ">:")
          inp (getstring msg spflag)
          inp (if (= inp "")
                def
                inp
              )
    )
    (progn
      (setq msg (strcat "\n" msg ": "))
      (if (= bit 1)
        (while (= "" (setq inp (getstring msg spflag))))
        (setq inp (getstring msg spflag))
      )
    )
  )
  (if inp
    inp
    def
  )
)
(defun _midp (p1 p2)
  (list        (+ (/ (- (car p1) (car p2)) 2) (car p2))
        (+ (/ (- (cadr p1) (cadr p2)) 2) (cadr p2))
  )
)
[/php]