Topic: Limit of vertices in list to use "_WP" with ssget?

[VVA]

algorithm is taken from here
The functions are written for the general case, but they can be optimized. For example, if you know that the text can be in only one contour, it can be excluded. In_Figure function checks to hit the inspected point not only inside but also on the border. You can simplify the function to test for entering only strictly inside the contour

Code: [Select]

;;;o test for entering point only strictly inside the contour
(defun In_Figure (Point Boundary / FarPoint Check)
 ;_Проверяет Boundary на условие car и last одна и та же точка
      (if (not (equal (car Boundary) (last Boundary) 1e-6))
        (setq Boundary (append Boundary (list (car Boundary))))
      ) ;_ end of if
      (setq FarPoint (cons (+ (apply 'max (mapcar 'car Boundary)) 1.0)
                           (cdr Point)
                     ) ;_ end of cons
      ) ;_ end of setq
;;;      (or
        (not
          (zerop
            (rem
              (length
                (vl-remove
                  nil
                  (mapcar
                    (function
                      (lambda (p1 p2) (inters Point FarPoint p1 p2))
                    ) ;_ end of function
                    Boundary
                    (cdr Boundary)
                  ) ;_ end of mapcar
                ) ;_ end of vl-remove
              ) ;_ end of length
              2
            ) ;_ end of rem
          ) ;_ end of zerop
        ) ;_ end of not
;;;        (vl-some (function (lambda (x) x))
;;;                 (mapcar
;;;                   (function (lambda (p1 p2)
;;;                               (or Check
;;;                                   (if (equal (+ (distance Point p1)
;;;                                                 (distance Point p2)
;;;                                              ) ;_ end of +
;;;                                              (distance p1 p2)
;;;                                              1e-3
;;;                                       ) ;_ end of equal
;;;                                     (setq Check t)
;;;                                     nil
;;;                                   ) ;_ end of if
;;;                               ) ;_ end of or
;;;                             ) ;_ end of lambda
;;;                   ) ;_ end of function
;;;                   Boundary
;;;                   (cdr Boundary)
;;;
;;;                 ) ;_ end of mapcar
;;;        ) ;_ end of vl-some
;;;      ) ;_ end of or
    )


[VVA]

I revised the function Is-none-text-inside-polyline. Now, as soon found the first text that is inside the polyline, then further to view a list of texts is not performed. This should speed up the work the command

Code: [Select]

(vl-load-com)
(defun C:TEST1 ( / ss textlist pllist)
  ;;;Move polyline to layer NO-HAVE-TEXT
(setq ss (ssget "_X" (list '(0 . "TEXT")(cons 410 (getvar "CTAB")))))
(setq textlist (pickset-to-list ss)) ;_List of text
(setq ss (ssget "_X" (list '(0 . "LWPOLYLINE")(cons 410 (getvar "CTAB")))))
(setq pllist (pickset-to-list ss));_list of boundary
(foreach pl (vl-remove-if-not '(lambda(x)(Is-none-text-inside-polyline x textlist)) pllist)
  (entmod (subst (cons 8 "NO-HAVE-TEXT")(assoc 8 (entget pl))(entget pl)))
  )
  )

(defun C:TEST2 ( / ss textlist pllist)
  ;;;Add hatch
(setq ss (ssget "_X" (list '(0 . "TEXT")(cons 410 (getvar "CTAB")))))
(setq textlist (pickset-to-list ss)) ;_List of text
(setq ss (ssget "_X" (list '(0 . "LWPOLYLINE")(cons 410 (getvar "CTAB")))))
(setq pllist (pickset-to-list ss));_list of boundary
(foreach pl (vl-remove-if-not '(lambda(x)(Is-none-text-inside-polyline x textlist)) pllist)
   ;; Pat - pattern
 ;; L - list point
 ;; A - angle hatch
 ;; N - name pattern
 ;; S - scale
  (entmakex-hatch
    (list(massoc 10 (entget pl))) ;_list point
    0                       ;_Angle hatch
    "ANSI31"                ;_Name Pattern
    1                       ;_Scale
    )
    )
  )


(defun [color=red]Is-none-text-inside-polyline[/color] ( polyline textlist / boundary Flag)
  ;;;Return T if polyline not have text inside
  (setq boundary (massoc 10 (entget polyline)))
  (setq Flag t) ;_polyline not have text inside
  [color=red](foreach text textlist
    (if (and Flag (In_Figure (cdr(assoc 10 (entget text))) boundary))
      (setq Flag nil);_polyline have text inside
      )
    )
   Flag[/color]
;;; Old version
;;;(apply 'and
;;;(mapcar '(lambda ( text )
;;;             (if (In_Figure (cdr(assoc 10 (entget text))) boundary)
;;;               nil
;;;               polyline
;;;               )
;;;             )
;;;          textlist
;;;          )
;;;         )
  )
       
(defun massoc (key alist)
(mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= key (car x)))) alist)))
(defun pickset-to-list (ss / item lst)
       (repeat (setq item (sslength ss)) ;_ end setq
         (setq lst (cons (ssname ss (setq item (1- item))) lst))
         ) ;_ end repeat

  lst
  ) ;_ end of defun

(defun entmakex-hatch (L a n s)
;; By ElpanovEvgeniy
;; L - list of list point
;; A - angle hatch
;; N - name pattern
;; S - scale
;; returne - hatch ename
(entmakex
  (apply
   'append
   (list
    (list '(0 . "HATCH")
          '(100 . "AcDbEntity")
          '(410 . "Model")
          '(100 . "AcDbHatch")
          '(10 0.0 0.0 0.0)
          '(210 0.0 0.0 1.0)
          (cons 2 n)
          (if (= n "SOLID")
           '(70 . 1)
           '(70 . 0)
          ) ;_  if
          '(71 . 0)
          (cons 91 (length l))
    ) ;_  list
    (apply 'append
           (mapcar '(lambda (a)
                     (apply 'append
                            (list (list '(92 . 7) '(72 . 0) '(73 . 1) (cons 93 (length a)))
                                  (mapcar '(lambda (b) (cons 10 b)) a)
                                  '((97 . 0))
                            ) ;_  list
                     ) ;_  apply
                    ) ;_  lambda
                   l
           ) ;_  mapcar
    ) ;_  apply
    (list '(75 . 0)
          '(76 . 1)
          (cons 52 a)
          (cons 41 s)
          '(77 . 0)
          '(78 . 1)
          (cons 53 a)
          '(43 . 0.)
          '(44 . 0.)
          '(45 . 1.)
          '(46 . 1.)
          '(79 . 0)
          '(47 . 1.)
          '(98 . 2)
          '(10 0. 0. 0.0)
          '(10 0. 0. 0.0)
          '(451 . 0)
          '(460 . 0.0)
          '(461 . 0.0)
          '(452 . 1)
          '(462 . 1.0)
          '(453 . 2)
          '(463 . 0.0)
          '(463 . 1.0)
          '(470 . "LINEAR")
    ) ;_  list
   ) ;_  list
  ) ;_  apply
) ;_  entmakex
) ;_  defun

(defun In_Figure (Point Boundary / FarPoint Check)
 ;_Проверяет Boundary на условие car и last одна и та же точка
      (if (not (equal (car Boundary) (last Boundary) 1e-6))
        (setq Boundary (append Boundary (list (car Boundary))))
      ) ;_ end of if
      (setq FarPoint (cons (+ (apply 'max (mapcar 'car Boundary)) 1.0)
                           (cdr Point)
                     ) ;_ end of cons
      ) ;_ end of setq
      (or
        (not
          (zerop
            (rem
              (length
                (vl-remove
                  nil
                  (mapcar
                    (function
                      (lambda (p1 p2) (inters Point FarPoint p1 p2))
                    ) ;_ end of function
                    Boundary
                    (cdr Boundary)
                  ) ;_ end of mapcar
                ) ;_ end of vl-remove
              ) ;_ end of length
              2
            ) ;_ end of rem
          ) ;_ end of zerop
        ) ;_ end of not
        (vl-some (function (lambda (x) x))
                 (mapcar
                   (function (lambda (p1 p2)
                               (or Check
                                   (if (equal (+ (distance Point p1)
                                                 (distance Point p2)
                                              ) ;_ end of +
                                              (distance p1 p2)
                                              1e-3
                                       ) ;_ end of equal
                                     (setq Check t)
                                     nil
                                   ) ;_ end of if
                               ) ;_ end of or
                             ) ;_ end of lambda
                   ) ;_ end of function
                   Boundary
                   (cdr Boundary)

                 ) ;_ end of mapcar
        ) ;_ end of vl-some
      ) ;_ end of or
    )


[Brick_top]

This is great!

I'm out of words, can't thank you enough.

I hope you have fun coding this stuff, I know I would