对一组选中的数字标记其中的最大值和最小值框选改为多边形内

qfkxc

如何将下面程序的框选功能修改为多边形内
原帖：对一组选中的数字标记其中的最大值和最小值
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=81904&highlight=%D7%EE%B4%F3%D6%B5
原帖代码：

;; Qiu Feng, 2010-05-06
;; 此程序用于标记一组整数中的最大值和最小值。
;; 命令：MarkMinMax
(vl-load-com)
;; 全局变量
(setq *MarkMinMax_doc* (vla-get-activedocument (vlax-get-acad-object)))
(setq *MarkMinMax_sysvar* nil)
(defun MarkMinMax_savevar (varlist / var)
  (setq *MarkMinMax_sysvar* nil)
  (foreach var varlist
    (setq *MarkMinMax_sysvar*
    (cons (cons var (getvar var))
   *MarkMinMax_sysvar*
    )
    )
  )
)
(defun MarkMinMax_resvar (/ var)
  (foreach var *MarkMinMax_sysvar*
    (if (getvar (car var))
      ;; 保证这个版本中存在这种系统变量
      (setvar (car var) (cdr var))
    )
  )
  (setq *MarkMinMax_sysvar* nil)
)
(defun c:MarkMinMax ()
  (vla-startundomark *MarkMinMax_doc*)
  (MarkMinMax_savevar '("cmdecho" "osmode"))
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (vl-catch-all-apply 'MarkMinMax nil)
  (MarkMinMax_resvar)
  (vla-endundomark *MarkMinMax_doc*)
  (princ)
)
(defun MarkMinMax (/ ss sslist mi ma std-sslist SelectNumbericText)
  ;; Selection Set => ordered list of entities
  (defun STD-SSLIST (ss / n lst)
    (if (eq 'PICKSET (type ss))
      (repeat (setq n (fix (sslength ss))) ; fixed
(setq lst (cons (ssname ss (setq n (1- n))) lst))
      )
    )
  )
  ;; 选择数字
  (defun SelectNumbericText (/ ss regexp sslist e)
    (setq regexp (vlax-create-object "Vbscript.RegExp"))
    (if (null regexp)
      (progn
(princ "\n正则表达式引擎初始化失败。")
(exit)
      )
    )
    (setq ss (ssget '((0 . "*TEXT"))))
    (setq sslist (std-sslist ss))
    (vlax-put-property regexp "IgnoreCase" :vlax-true) ;忽略大小写
    (vlax-put-property regexp "Global" :vlax-true)
     ;匹配方式，全文字匹配
    (vlax-put-property
      regexp
      "Pattern"
      "^[-+]?[0-9]*\\.?[0-9]+\\b$"
    )
    (foreach e sslist
      (if (= :vlax-false
      (vlax-invoke-method
        regexp
        "Test"
        (cdr (assoc 1 (entget e)))
      )
   )
(ssdel e ss)
      )
    )
    ss
  )
  ;; textbox
  (defun marktextbox (n color / nlist entlist boxlist box ptlist)
    (vl-cmdf "select" ss "")
    (setq
      nlist (std-sslist (ssget "P" (list '(0 . "*TEXT") (cons 1 n))))
    )
    (setq entlist (mapcar 'entget nlist))
    (setq boxlist (mapcar 'textbox entlist))
    (setq ptlist (mapcar '(lambda (ent) (cdr (assoc 10 ent))) entlist))
    (setq
      ptlist (mapcar '(lambda (pt) (list (car pt) (cadr pt))) ptlist)
    )
    (setq
      boxlist (mapcar '(lambda (box p)
    (mapcar '(lambda (p1)
        (mapcar '+ p1 p)
      )
     box
    )
         )
        boxlist
        ptlist
       )
    )
    (foreach box boxlist
      (vl-cmdf "rectang")
      (apply 'vl-cmdf box)
      (vl-cmdf "chprop" (entlast) "" "color" color "")
    )
  )
  ;; ----------
  ;; main
  ;; ----------
  (setq ss (SelectNumbericText))
  (setq sslist (std-sslist ss))
  (setq sslist
  (vl-sort sslist
    (function (lambda (e1 e2)
         (< (distof (cdr (assoc 1 (entget e1))))
     (distof (cdr (assoc 1 (entget e2))))
         )
       )
    )
  )
  )
  (setq mi (cdr (assoc 1 (entget (car sslist)))))
  (setq ma (cdr (assoc 1 (entget (last sslist)))))
  ;; 红色标记最小值
  (marktextbox mi 1)
  ;; 绿色标记最大值
  (marktextbox ma 3)
  (princ)
)

xyp1964

2. ;; 需要e派工具箱(XCAD)的支持：[url=http://xyp1964.ys168.com]http://xyp1964.ys168.com[/url]
   
3. (defun c:tt ()
   
4.   (CMDLA0)
   
5.   (if (setq p1 (getpoint "\n基点<退出>: "))
   
6.     (progn
   
7.       (command "pline" p1)
   
8.       (while (setq p2 (getpoint p1 "\n基点<退出>: "))
   
9. (command p2)
   
10. (setq p1 p2
    
11. )
    
12.       )
    
13.       (command "c")
    
14.       (setq s1 (entlast)
    
15.      ptn (xyp-get-Vertexs s1 0)
    
16.       )
    
17.       (xyp-erase s1)
    
18.     )
    
19.   )
    
20.   (if (setq ss (ssget "WP" ptn '((0 . "TEXT") (1 . "~*[~`--9]*"))))
    
21.     (progn
    
22.       (setq lst (xyp-Sort ss 1 "none")
    
23.      s1 (cdar lst)
    
24.      s2 (cdr (last lst))
    
25.       )
    
26.       (xyp-circle
    
27. (xyp-get-MinMaxPoint s1 5)
    
28. (xyp-get-dxf 40 s1)
    
29.       )
    
30.       (xyp-circle
    
31. (xyp-get-MinMaxPoint s2 5)
    
32. (xyp-get-dxf 40 s2)
    
33.       )
    
34.     )
    
35.   )
    
36.   (CMDLA1)
    
37. )

;; 需要e派工具箱(XCAD)的支持：[url=http://xyp1964.ys168.com]http://xyp1964.ys168.com[/url]<br /> (defun c:tt ()<br />   (CMDLA0)<br />   (if (setq p1 (getpoint "\n基点<退出>: "))<br />     (progn<br />       (command "pline" p1)<br />       (while (setq p2 (getpoint p1 "\n基点<退出>: "))<br /> (command p2)<br /> (setq p1 p2<br /> )<br />       )<br />       (command "c")<br />       (setq s1 (entlast)<br />      ptn (xyp-get-Vertexs s1 0)<br />       )<br />       (xyp-erase s1)<br />     )<br />   )<br />   (if (setq ss (ssget "WP" ptn '((0 . "TEXT") (1 . "~*[~`--9]*"))))<br />     (progn<br />       (setq lst (xyp-Sort ss 1 "none")<br />      s1 (cdar lst)<br />      s2 (cdr (last lst))<br />       )<br />       (xyp-circle<br /> (xyp-get-MinMaxPoint s1 5)<br /> (xyp-get-dxf 40 s1)<br />       )<br />       (xyp-circle<br /> (xyp-get-MinMaxPoint s2 5)<br /> (xyp-get-dxf 40 s2)<br />       )<br />     )<br />   )<br />   (CMDLA1)<br /> )