框选 标注出矩形的规格 在每个矩形的旁边

天下第五坑

网上找了两个代码，一个可以框选得到  多段线外形最大外形的矩形；一个可以点选 标注出矩形长宽规格。能不能将这两个程序整合一下；或其他思路编写，可直接框选所有矩形，并直接在每个矩形附近生成长宽的规格。
感觉有几种解法，但lisp基本功太差，求大神改改
1、得出矩形任意顶点， 代替 (setq PT1 (getpoint "\n选择点:"))
2、取得矩形几何中心，代替  (setq PT1 (getpoint "\n选择点:"))
代码1
(defun c:tes ( / &kw ent ss1 sx x1 x2 y1 y2)
(vl-load-com)
(princ "\n请选择对象")
(if (setq &kw (ssget))
  (progn
   (setq ss1 '())
   (while (setq ent (ssname &kw 0))
    (setq &kw (ssdel ent &kw) ss1 (cons ent ss1))
   );while
   (setq ss1 (mapcar 'vlax-ename->vla-object ss1))
   (setq ss1 (apply 'append (mapcar 'x1903211 ss1)))
   (setq sx (vl-sort (mapcar 'car ss1) '<))
   (setq x1 (car sx) x2 (last sx))
   (setq sx (s1905271 x1 x2) x1 (car sx) x2 (cadr sx))
   (setq sx (vl-sort (mapcar 'cadr ss1) '<))
   (setq y1 (car sx) y2 (last sx))
   (setq sx (s1905271 y1 y2) y1 (car sx) y2 (cadr sx))
   (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) '(38 . 0) (cons 10 (list x1 y1)) (cons 10 (list x2 y1)) (cons 10 (list x2 y2)) (cons 10 (list x1 y2))))
  )
)
(princ)
)

;长度为小数点后0位
(defun s1905271 (i1 i2 / i i1 i2 i3 i4)
(setq i3 (* 0.5 (+ i2 i1)) i4 (- i2 i1) i (atof (rtos i4 2 0)))
(if (> i4 i) (setq i (+ i 1)) )
(setq i (* 0.5 i))
(list (- i3 i) (+ i3 i))
)
  
(defun x1903211 (obj / obj x y)
(vla-getboundingbox obj 'x 'y)
(mapcar 'vlax-safearray->list (list x y));点表
)

代买2
(defun c:dd (/ area di ename gao kuan pts x PT2 PT3 PT21 PT31 PT1 tet)
  (setq ename(car(entsel"\n选择一个矩形")))
  (while (or
           (/= "LWPOLYLINE" (_get-dxf ename 0))
           (/= 4 (length(setq pts(_Vertexs ename))))
           (setq di (mapcar '(lambda(a b)(distance a b))pts (cons (last pts)pts))
             kuan(car di)
             gao(cadr di)
             area(try-get-aear ename)
             x(not(equal (* kuan gao) area))
           )
         )
    (setq ename (car(entsel "\n只能选择矩形多段线，请重新选择")))
  )
  (princ(strcat"\n长："(rtos kuan 2 0)",宽："(rtos gao 2 0)))
  (setq PT2 (+ 0.25 (/ kuan 10)))
  (setq PT3 (+ 0.25 (/ gao 10)))
  (setq PT2 (rtos PT2 2 0))
  (setq PT3 (rtos PT3 2 0))
  (setq PT2 (atof PT2))
  (setq PT3 (atof PT3))
  (setq PT21 (* PT2 10))
  (setq PT31 (* PT3 10))
  (setq PT21 (rtos PT21 2 0))
  (setq PT31 (rtos PT31 2 0))
  (setq tet (strcat "*" PT21 "*" PT31))
  (setq PT1 (getpoint "\n选择点:"))
  (command "_text" "J" "C"  PT1 "175" "0" tet)
  (princ)
)

;;;======================================
;;;===========以下为**部分=============
;;;======================================
(defun _get-dxf (en code / ty)
  (cdr (assoc code (entget en '("*"))))
)
(defun _Vertexs (ename / data lst);
  (setq  data (entget ename))
  (setq lst (vl-remove-if-not '(lambda (x) (= (car x) 10)) data))
  (mapcar 'cdr lst)
)
(defun try-get-aear (en)(vla-get-Area(try-object en)))
(defun try-StringReplace(str a b);;BY：LLSheng_73
  (if(and(=(type str)'str)
       (apply'and(mapcar'(lambda(x)(=(type x)'str))(setq a(if(=(type a)'list)a(list a)))))
       (apply'and(mapcar'(lambda(x)(=(type x)'str))(setq b(if(=(type b)'list)b(mapcar'(lambda(x)b)a))))))
    (setq str(_strsplit str a nil)
      str(apply'strcat(mapcar'strcat(car str)(mapcar'(lambda(x)(if(=""x)x(nth(vl-position x a)b)))(last str)))))
    str))
(defun try-ss2EnList(ss / a en lst)
  (setq a -1)
  (if ss
    (while
      (setq en(ssname ss(setq a(1+ a))))
      (setq lst(cons en lst))
    )
  )
  (reverse lst)
)
(defun try-lst-div (lst nn / lst2)
  (foreach n lst
    (if (and lst2 (/= nn (length (car lst2))))
      (setq lst2 (cons (append (car lst2) (list n)) (cdr lst2)))
      (setq lst2 (cons (list n) lst2))
    )
  )
  (reverse lst2)
)
(defun try-object (en)(if(= 'ename (type en))(vlax-ename->vla-object en)en))
(defun _strsplit(str splits f / i a b l );;BY：LLSheng_73
  (if f(setq str(vl-list->string(vl-remove 32(vl-string->list str)))))
  (while(<""str)
    (if(vl-remove'nil(mapcar'(lambda(x)(vl-string-search x str))splits))
      (setq i(car(vl-sort(vl-remove'nil(mapcar'(lambda(x)(if(setq l(vl-string-search x str))(cons l x)))splits))
                   '(lambda(s1 s2)(<(car s1)(car s2)))))
        a(cons(substr str 1(car i))a)b(cons(cdr i)b)
        str(substr str(+(car i)(strlen(cdr i))1)))
      (setq a(cons str a)b(cons "" b)str"")))
  (list(reverse a)(reverse b)))


[/code]

天下第五坑

谢谢，已解决

天下第五坑

直接抓取矩形最大外形操作
(defun c:te ( / &kw ent ss1 sx x1 x2 y1 y2 L0 W0 L W L1 W1 tet PT0 PT1 PT2 PT3 PT4 PT14 PT34 BK BH x10 y10 x11 y11 x22 y12 x23 y23 x14 y24 )
(vl-load-com)
(princ "\n请选择对象")
(if (setq &kw (ssget))
  (progn
   (princ " 14mm-10  25mm-10  30mm-15 ")
   (princ " 40mm-15  80mm-20  120mm-20")
   (setq BH (getreal "\n输入板厚:"))
   (setq BK (getreal "\n输入留边量:"))
   (setq ss1 '())
   (while (setq ent (ssname &kw 0))
    (setq &kw (ssdel ent &kw) ss1 (cons ent ss1))
   );while
   (setq ss1 (mapcar 'vlax-ename->vla-object ss1))
   (setq ss1 (apply 'append (mapcar 'x1903211 ss1)))
   (setq sx (vl-sort (mapcar 'car ss1) '<))
   (setq x1 (car sx) x2 (last sx))
   (setq sx (s1905271 x1 x2) x1 (car sx) x2 (cadr sx))
   (setq sx (vl-sort (mapcar 'cadr ss1) '<))
   (setq y1 (car sx) y2 (last sx))
   (setq sx (s1905271 y1 y2) y1 (car sx) y2 (cadr sx))
   (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) '(38 . 0) (cons 10 (list (- x1 BK) (- y1 BK))) (cons 10 (list (+ x2 BK) (- y1 BK))) (cons 10 (list (+ x2 BK) (+ y2 BK))) (cons 10 (list (- x1 BK) (+ y2 BK)))))
   (setq L0 (- (+ x2 BK) (- x1 BK)))
   (setq W0 (- (+ y2 BK) (- y1 BK)))
   (setq L (+ 0.25 (/ L0 10)))
   (setq W (+ 0.25 (/ W0 10)))
   (setq L (rtos L 2 0))
   (setq W (rtos W 2 0))
   (setq L (atof L))
   (setq W (atof W))
   (setq L1 (* L 10))
   (setq W1 (* W 10))
   (setq L1 (rtos L1 2 0))
   (setq W1 (rtos W1 2 0))
   (setq tet (strcat (RTOS BH 2 0) "*" W1 "*" L1))
   (setq x10 (rtos (+ x1 (+ 1000 BK))))
   (setq y10 (rtos (- y1 (+ 1000 BK))))
   (setq PT0 (strcat x10 "," y10))
   (command "_text" "J" "ML" PT0 "175" "0" tet)
   (setq x11 (rtos (- x1 (+ 0 BK))))
   (setq y11 (rtos (- y1 (+ 0 BK))))
   (setq x22 (rtos (+ x2 (+ 0 BK))))
   (setq y12 (rtos (- y1 (+ 0 BK))))
   (setq x23 (rtos (+ x2 (+ 0 BK))))
   (setq y23 (rtos (+ y2 (+ 0 BK))))
   (setq x14 (rtos (- x1 (+ 0 BK))))
   (setq y24 (rtos (+ y2 (+ 0 BK))))
   (setq PT1 (strcat x11 "," y11))
   (setq PT3 (strcat x23 "," y23))
   (setq PT4 (strcat x14 "," y24))
   (setq PT14 (strcat (rtos (- (atof x11) 200)) "," (rtos (atof y11))))
   (setq PT34 (strcat (rtos (atof x23)) "," (rtos (+ (atof y23) 200))))
   (command "DIMLINEAR" PT1 PT4 PT14 )
   (command "DIMLINEAR" PT3 PT4 PT34 )
   (princ)
  )
)
(princ)
)

;长度为小数点后0位
(defun s1905271 (i1 i2 / i i1 i2 i3 i4)
(setq i3 (* 0.5 (+ i2 i1)) i4 (- i2 i1) i (atof (rtos i4 2 0)))
(if (> i4 i) (setq i (+ i 1)) )
(setq i (* 0.5 i))
(list (- i3 i) (+ i3 i))
)
  
(defun x1903211 (obj / obj x y)
(vla-getboundingbox obj 'x 'y)
(mapcar 'vlax-safearray->list (list x y));点表
)