Topic: Mtext locator

[V-Man]

I am trying to come up with a way to search through all of my LWpolylines for a peice of Mtext that resides within the LWpolyline and once
found hatch the LWpolyline. Can anyone assist?

[CAB]

Need more rules please.

I can help with the questions.

• Is the layer constant?
• Is the pline closed?
• Is there anything about the pline that is unique or will the user be picking the pline?
• Is there something unique about the text other than it is surrounded by a pline?

[V-Man]

Is the layer constant? Yes
Is the pline closed? Yes
Is there anything about the pline that is unique or will the user be picking the pline? No, user can select the entire drawing, thus selcting all lwpolylines at one time.
Is there something unique about the text other than it is surrounded by a pline?  No

[CAB]

OK, looking at this code, http://www.theswamp.org/index.php?topic=20705.msg251590#msg251590
there are some similarities. That code gets lines within rectangles. You want text within closed plines.

Here is the psudo code.

Get closed plines on a spacific layer in current space
Use the vertex points for a second ssget to get any mtext within the pline boundaries
If you find any mtext, hatch the pline

How is that for what you want to do?

What is the layer name for the closed pline.
What is the hatch pattern?
What is the hatch scale?
What is the hatch layer?

So looking at the routine I pointed to you would need to allow ssget to get ANY closed pline.
This already does that:

Code: [Select]

(setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE") (-4 . "&") (70 . 1))))So all you need to do is add the layer and eliminate the test for the rectangle.
Here is the layer added:

Code: [Select]

(setq ss (ssget '((8 . "[color=red]LayerName[/color]")(0 . "LWPOLYLINE,POLYLINE") (-4 . "&") (70 . 1))))and this is the rectangle test  (if (is_rectangle pts) so delete that line & the closing parens.

This line gets any LINES within the rectangle and you want MTEXT, so change this

Code: [Select]

(setq ss2 (ssget "f" pts (list '(0 . "LINE") (cons 8 lay))))to this, deleting the layer filter & changing the Fence to Crossing Polygon

Code: [Select]

(setq ss2 (ssget "cp" pts (list '(0 . "MTEXT"))))
Get rid of this line:

Code: [Select]

(setq lay (vla-get-layer obj))and this line

Code: [Select]

(setq lines (get_lines lst2 pts lay))
Remove sub functions:
make_line
get_lines
is_rectangle

Change the routine name to FindMText
Oh, change the prompt to:

Code: [Select]

(prompt "\nSelect Plines for Text Identification.")
Remove the delete lines code

Code: [Select]

              ;; got two lines for X so remove them
              (vl-catch-all-apply '(lambda ()
                (mapcar '(lambda (x) (vla-delete (vlax-ename->vla-object x))) lines)))
Remove the make lines function calls:

Code: [Select]

                (make_line (car pts) (caddr pts) lay)
                (make_line (cadr pts) (last pts) lay)
Now we have this:

Code: [Select]

(defun c:FindmText (/ ss lst obj pts lay ss2 lst2 lines)
  (vl-load-com)
  (defun group_on2 (InpLst / OutLst)
    (while InpLst
      (setq OutLst (cons (list (car InpLst) (cadr InpLst)) OutLst))
      (setq InpLst (cddr InpLst))
    )
    OutLst
  )


  ;;  ****   S T A R T   H E R E    ****
  (prompt "\nSelect Plines for Text Identification.")
  (setq ss (ssget '((8 . "[color=red]LayerName[/color]")(0 . "LWPOLYLINE,POLYLINE") (-4 . "&") (70 . 1))))
  (if ss
    (progn
      (setq lst (mapcar 'vlax-ename->vla-object
                        (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
      (foreach obj lst
        (setq pts (group_on2 (vlax-get obj 'coordinates)))
          (progn
            (setq lay (vla-get-layer obj))
            (if (and
                  (setq ss2 (ssget "cp" pts (list '(0 . "MTEXT"))))
                  (setq lst2 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
                )
              (progn
                (command "-bhatch" "S" (vlax-vla-object->ename obj)
                         "" "P" "[color=red]ANSI31[/color]" "[color=red]100[/color]" "0" "")
              )
            )
          )
      )
    )
  )
  (princ)
)
Notice that I added a command bhatch.
You will need to change the bhatch hatch name & scale
Also you will need to replace LayerName in the ssget.

[SomeCallMeDave]

It appears that CAB has provided the solution that you asked for, but I was wondering...

Would it be easier to pick the MTEXT and then find the closest bounding polyline and use that as a hatch boundary. 

Since I don't know the entire problem and the data set that you have,  I can't be sure.  But if the MTEXT is surrounded by more than one polyline,  picking the MTEXT might be the route to go.  On the other hand,  if the polylines are more 'identifiable' then you probably have what you need.

Just a thought that popped into my head.  Feel free to dis-regard

[V-Man]

Thanks for the comments and hard work CAB. I will look into the code and study it.

Would it be easier to pick the MTEXT and then find the closest bounding polyline and use that as a hatch boundary.

This is not an option for me. Basically the lwpolylines are room boundaries for a floor plan with a peice Mtext residing inside each of the closed lwpolylines.

[V-Man]

After playing around with the code, it just is not working to well so I thought of another idea.

How about I try this again but with a different perspective. I would like for the routine to search all lwpolylines in the drawing and hatch only
the lwpolylines with no MTEXT residing within the lwpolyline. But this time I need it to see if the insertion point of the MTEXT is inside the lwpolyline.

[ronjonp]

Maybe this line (setq ss2 (ssget "cp" pts (list '(0 . "MTEXT")))) could be changed to: (not (setq ss2 (ssget "W" pts (list '(0 . "MTEXT")))))...then only mtext that completely resides within the polyline will be detected.

Ron

[CAB]

dvarino,
Perhaps if you posted a sample DWG we could offer another perspective for the solution?

[T.Willey]

Don't forget that when you go the route of 'ssget' with 'crossing' or 'windowing' selections that the points that you are using have to be on screen or else you won't get the results you are expecting.

[V-Man]

Here you go.

Thanks guys

[V-Man]

I updated the drawing here

[CAB]

The problem was douplicate points in the vertex list.
ssget does not like them.
Note: change the layer name.

Code: [Select]

(defun c:FindMText (/ ss lst obj pts lay ss2 lst2 lines)
  (vl-load-com)
  (defun group_on2 (InpLst / OutLst)
    (while InpLst
      (setq OutLst (cons (list (car InpLst) (cadr InpLst)) OutLst))
      (setq InpLst (cddr InpLst))
    )
    OutLst
  )

  (defun unique (lst / result)
    (while (setq itm (car lst))
      (if (null result)
        (setq result (list itm))
        (if (> (distance itm (car result)) 0.00001)
          (setq result (cons itm result))
        )
      )
      (setq lst (cdr lst))
    )
    result
  )

 
  ;;  ****   S T A R T   H E R E    ****
  (prompt "\nSelect Plines for Text Identification.")
  (setq ss (ssget '((8 . "LAYER1")(0 . "LWPOLYLINE,POLYLINE") (-4 . "&") (70 . 1))))
  (if ss
    (progn
      (setq lst (mapcar 'vlax-ename->vla-object
                        (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
      (foreach obj lst
        (setq pts (unique (group_on2 (vlax-get obj 'coordinates))))
        (if (and
                (setq ss2 (ssget "cp" pts '((0 . "MTEXT"))))
                (setq lst2 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
              )
            (command "-bhatch" "S" (vlax-vla-object->ename obj)
                     "" "P" "ANSI31" "100" "0" "")
        )
      )
    )
  )
  (princ)
)

[V-Man]

CAB,

I ran the code and I get the following....

FINDMTEXT
Select Plines for Text Identification.
Select objects: Specify opposite corner: 8 found
6 were filtered out.

Select objects:

no function definition: nil; error: An error has occurred inside the *error*
functionno function definition: ASE_ERRQTY

[CAB]

Are you using the same test DWG that I have?

Here is another version with a local error handler.
Does it give an error & what message is displayed?

Code: [Select]

(defun c:FindMText (/ ss lst obj pts lay ss2 lst2 lines
                    *error* group_on2 unique)
  (vl-load-com)
  (defun *error* (msg)
    (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    )
    (princ)
  ) ;end error function
 
  (defun group_on2 (InpLst / OutLst)
    (while InpLst
      (setq OutLst (cons (list (car InpLst) (cadr InpLst)) OutLst))
      (setq InpLst (cddr InpLst))
    )
    OutLst
  )

  (defun unique (lst / itm result)
    (while (setq itm (car lst))
      (if (null result)
        (setq result (list itm))
        (if (> (distance itm (car result)) 0.00001)
          (setq result (cons itm result))
        )
      )
      (setq lst (cdr lst))
    )
    result
  )

 
  ;;  ****   S T A R T   H E R E    ****
  (command "_undo" "_begin")
  (prompt "\nSelect Plines for Text Identification.")
  (setq ss (ssget '((8 . "LAYER1")(0 . "LWPOLYLINE,POLYLINE") (-4 . "&") (70 . 1))))
  (if ss
    (progn
      (setq lst (mapcar 'vlax-ename->vla-object
                        (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
      (foreach obj lst
        (setq pts (unique (group_on2 (vlax-get obj 'coordinates))))
        (if (and
                (setq ss2 (ssget "cp" pts '((0 . "MTEXT"))))
                (setq lst2 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
              )
            (command "-bhatch" "S" (vlax-vla-object->ename obj)
                     "" "P" "ANSI31" "100" "0" "")
        )
      )
    )
  )
  (command "_undo" "_end")
  (princ)
)