[LISP程序]：坐标标注程序，应朋友要求写的，请大家指正

apollone

(defun c:IdDim(/ pt0x pt0y pt00 nnn pt1 pt1x pt1y pt2 lDist)
  (defun LispStart()
    (setq LUPREC (getvar "LUPREC"))
    (setvar "LUPREC" 3)
  )

  (defun LispEnd()
    (setvar "LUPREC" LUPREC)
  )

  (if (null pt0)
    (setq pt0  '(0 0))
  )
  (setq pt0x (car pt0) pt0y (cadr pt0))
  (setq pt00 (getpoint (strcat "基准点<" (rtos pt0x) "," (rtos pt0y) ">:")))
  (if (null pt00)
    (setq pt00  pt0)
    (setq pt0  pt00)
  )

  (if (null nn)
    (setq nn 1)
  )
  (setq nnn (getint (strcat "基准序号<" (itoa nn) ">:")))
  (if (null nnn)
    (setq nnn nn)
    (setq nn nnn)
  )

  (setq th (getreal (strcat "文字高度<" (rtos (getvar "textsize")) ">:")))
  (if (null th)
    (setq th (getvar "textsize"))
  )

  (if (null lDist0)
    (setq lDist0 0)
  )
  (setq lDist (getreal (strcat "文字行间距<" (rtos lDist0) ">:")))
  (if (null lDist)
    (setq lDist lDist0)
    (setq lDist0 lDist)
  )

  (LispStart)

  (setq pt0x (car pt0) pt0y (cadr pt0))
  (setq pt1 (getpoint pt0 (strcat "标注点 " (itoa nn) ":")))
  (while pt1
    (setq pt3 (getpoint pt1 "序号位置:"))
    (if (or (null pt2) (= ldist 0))
      (setq pt2 (getpoint pt1 "文字位置:"))
      (setq pt2 (list (car pt2) (- (cadr pt2) ldist)))
    )
    (setq pt1x (car pt1) pt1y (cadr pt1))
    (command "_circle" pt1 (* 0.2 (getvar "dimtxt")))
    (command "_text" "j" "mc" pt3 th "" (itoa nn))
    (command "_text" pt2 th "" (strcat "[" (itoa nn) "] x=" (rtos (- pt1x pt0x)) ", y=" (rtos (- pt1y pt0y))))
    (setq nn (1+ nn))
    (setq pt1 (getpoint pt0 (strcat "标注点 " (itoa nn) ":")))
  )
  (LispEnd)
  (princ)
)

最爱小蝎

多谢！