Jump to content

detect polyline and insert text inside/over it


Mehran

Recommended Posts

Hi,

I have thousands of drawings. They are all similar to This.dwg one.

My final goal is to merge them into one kml file..

This would take months to do it one by one.

If I have the right lisp to automate this in one drawing, then I can use script to run that lisp over other drawings.

 

To reduce the result file size, I decided to keep only the green polyline in the center of the drawing(which matters the most):

 

(defun C:foo ( / varf ins str)

;  Selecting Polyline
   (setq varf
       (list
          '(-4 . "<OR")
              '(0 . "LWPOLYLINE")
              '(-4 . "<AND")
                  '(0 . "POLYLINE")
                  '(-4 . "<NOT")
                      '(-4 . "&")
                      '(70 . 80)
                  '(-4 . "NOT>")
              '(-4 . "AND>")
          '(-4 . "OR>")
               (cons 62 3)
       )
   )
(sssetfirst nil (ssget "_X" varf))

; Inverting selection 
 (if (ssget "_I")
  (progn; then
   (sssetfirst nil)
   (command "_.select" "_all" "_remove" (ssget "_p") "")
   (sssetfirst nil (ssget "_p"))
  ) 
  (prompt "\nRequires pre-selection."); else
)

; Delete Selection
(command "_.erase")

; And This is how I insert Drawing Name 
  (and (or (> (getvar 'DWGTITLED) 0)
           (alert "Save the drawing then try again!")
       )
       (setq ins (getpoint "\nChoose Insertion Point: "))
       (setq str (entmakex (list '(0 . "MTEXT")
                                 '(100 . "AcDbEntity")
                                 '(100 . "AcDbMText")
                                 (cons 10 (trans ins 1 0))
		                 (cons 40   0.8);Text height
	                         (cons 7   "STANDARD");Text style
                                 '(1 . "")
                           )
                 )
       )
       (vla-put-textstring (vlax-ename->vla-object str)
			"%<\\AcVar Filename \\f \"%tc4%fn2\">%}"
       )
  )
)

 

Now these are what I'm looking for:

- I don't want to pick the insertion point manually,  need to insert field inside or over selected polyline 

- after inserting field text, I want to explode the text. to maintain drawing name after merge.

- adding a condition to check the process, if anything goes wrong, insert that drawing name at (0,0,0). this way I can track that file to check it manually.

Thank you in Advanced.
 

Link to comment
Share on other sites

As a start I'll post this and see where you go from there. 

 

I've put your entmakex part into a sub-routine - easier for the next step where you insert the filename at the origin (saves copying the code twice) and copied in a small routine to get the centre point of an entity bounding box. Also gave your selection set a name (MySS) to make it easier to refer to later.

 

So this should now put the fllename in the centre of the first polyline in the selection set. Do you need the filename in all the polylines (the green boxes) ? noting in your example there are 2.  We can add a loop through the selection set (MySS) to do that  Wasn't looking at your drawing properly then, will need to delete the green outline that is in the border so the LISPs don't get confused as what to look at. I'll assume that the detail is always in the bottom of the border, that is below the green outlie that you want to keep?

 

For the filenames, is there a reason that you want to insert that as a field or can it just be inserted straight as a text string? (noting you mention conditional checking comes later)

 

 

Can modify this later if you let me know about the filename - in all the green boxes or not and enter as a string or field?

 

 

(defun C:foo ( / varf ins str MySS)
  ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/zoom-object-problem/td-p/5031146
  (defun GetCentre (ent / minPt maxPt ll ur)
    (vla-GetBoundingBox (vlax-ename->vla-object ent)
      'minPt
      'maxpt
    )
    (setq ll (car (cons (vlax-safearray->list minPt) ll))
          ur (car (cons (vlax-safearray->list maxPt) ur))
    )
    (setq inspt (list (/ (+ (car ll) (car ur)) 2) (/ (+ (cadr ll) (cadr ur)) 2)) )
  )

  (defun MakeText ( ins / )
    (entmakex (list '(0 . "MTEXT")
                    '(100 . "AcDbEntity")
                    '(100 . "AcDbMText")
                    (cons 10 (trans ins 1 0))
	            (cons 40   0.8);Text height
	            (cons 7   "STANDARD");Text style
                    '(1 . "")
              ) ; end list
    ) ; end entmakex
  ) ; end defun


;  Selecting Polyline
   (setq varf
       (list
          '(-4 . "<OR")
              '(0 . "LWPOLYLINE")
              '(-4 . "<AND")
                  '(0 . "POLYLINE")
                  '(-4 . "<NOT")
                      '(-4 . "&")
                      '(70 . 80)
                  '(-4 . "NOT>")
              '(-4 . "AND>")
          '(-4 . "OR>")
               (cons 62 3)
       )
   )
(sssetfirst nil (setq MySS (ssget "_X" varf))) ;; ADDED A NAME TO THE SELECTION SET

; Inverting selection 
 (if (ssget "_I")
  (progn; then
   (sssetfirst nil)
   (command "_.select" "_all" "_remove" (ssget "_p") "")
   (sssetfirst nil (ssget "_p"))
  ) 
  (prompt "\nRequires pre-selection."); else
)

; Delete Selection
(command "_.erase")


; And This is how I insert Drawing Name 
  (and (or (> (getvar 'DWGTITLED) 0)
           (alert "Save the drawing then try again!")
       )

;;       (setq ins (getpoint "\nChoose Insertion Point: "))
(setq ins (GetCentre  (ssname MySS 0) ) )

       (setq str (MakeText ins) )
       (vla-put-textstring (vlax-ename->vla-object str)
			"%<\\AcVar Filename \\f \"%tc4%fn2\">%}"
       )
  )
)

 

 

No doubt there will be other suggestions but this is based on what you have made up so far

 

Edited by Steven P
  • Like 1
Link to comment
Share on other sites

28 minutes ago, Steven P said:

is there a reason that you want to insert that as a field or can it just be inserted straight as a text string?

 

 

 

Can modify this later if you let me know about the filename - in all the green boxes or not and enter as a string or field?

 

 

(defun C:foo ( / varf ins str MySS)
  ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/zoom-object-problem/td-p/5031146
  (defun GetCentre (ent / minPt maxPt ll ur)
    (vla-GetBoundingBox (vlax-ename->vla-object ent)
      'minPt
      'maxpt
    )
    (setq ll (car (cons (vlax-safearray->list minPt) ll))
          ur (car (cons (vlax-safearray->list maxPt) ur))
    )
    (setq inspt (list (/ (+ (car ll) (car ur)) 2) (/ (+ (cadr ll) (cadr ur)) 2)) )
  )

  (defun MakeText ( ins / )
    (entmakex (list '(0 . "MTEXT")
                    '(100 . "AcDbEntity")
                    '(100 . "AcDbMText")
                    (cons 10 (trans ins 1 0))
	            (cons 40   0.8);Text height
	            (cons 7   "STANDARD");Text style
                    '(1 . "")
              ) ; end list
    ) ; end entmakex
  ) ; end defun


;  Selecting Polyline
   (setq varf
       (list
          '(-4 . "<OR")
              '(0 . "LWPOLYLINE")
              '(-4 . "<AND")
                  '(0 . "POLYLINE")
                  '(-4 . "<NOT")
                      '(-4 . "&")
                      '(70 . 80)
                  '(-4 . "NOT>")
              '(-4 . "AND>")
          '(-4 . "OR>")
               (cons 62 3)
       )
   )
(sssetfirst nil (setq MySS (ssget "_X" varf))) ;; ADDED A NAME TO THE SELECTION SET

; Inverting selection 
 (if (ssget "_I")
  (progn; then
   (sssetfirst nil)
   (command "_.select" "_all" "_remove" (ssget "_p") "")
   (sssetfirst nil (ssget "_p"))
  ) 
  (prompt "\nRequires pre-selection."); else
)

; Delete Selection
(command "_.erase")


; And This is how I insert Drawing Name 
  (and (or (> (getvar 'DWGTITLED) 0)
           (alert "Save the drawing then try again!")
       )

;;       (setq ins (getpoint "\nChoose Insertion Point: "))
(setq ins (GetCentre  (ssname MySS 0) ) )

       (setq str (MakeText ins) )
       (vla-put-textstring (vlax-ename->vla-object str)
			"%<\\AcVar Filename \\f \"%tc4%fn2\">%}"
       )
  )
)

 

 

Thank you Stephen,

- Not necessarily, filename can also be as string text.

- All of the green polylines the better.

  • Like 1
Link to comment
Share on other sites

Try this one,  it should put the filename in all the green boxes (noting this includes the green box in the border), plus filename in the origin (0,0) - try it and see and let me know any comments

 

 

(defun C:foo ( / varf ins str MySS)
  ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/zoom-object-problem/td-p/5031146
  (defun GetCentre (ent / minPt maxPt ll ur inspt) ;; gets the centre of the entity bounding box-ish
    (vla-GetBoundingBox (vlax-ename->vla-object ent)
      'minPt
      'maxpt
    )
    (setq ll (car (cons (vlax-safearray->list minPt) ll))
          ur (car (cons (vlax-safearray->list maxPt) ur))
    )
    (setq inspt (list (/ (+ (car ll) (car ur)) 2) (/ (+ (cadr ll) (cadr ur)) 2)) )
  )

  (defun MakeText ( ins txt / )
    (entmakex (list '(0 . "MTEXT")
                    '(100 . "AcDbEntity")
                    '(100 . "AcDbMText")
                    (cons 10 (trans ins 1 0))
	            (cons 40   0.8);Text height
                    (cons 1 txt)
	            (cons 7   "STANDARD");Text style
                    '(1 . "")
              ) ; end list
    ) ; end entmakex
  ) ; end defun


;  Selecting Polyline
    (setq varf
      (list
        '(-4 . "<OR")
          '(0 . "LWPOLYLINE")
          '(-4 . "<AND")
            '(0 . "POLYLINE")
            '(-4 . "<NOT")
              '(-4 . "&")
              '(70 . 80)
            '(-4 . "NOT>")
          '(-4 . "AND>")
        '(-4 . "OR>")
        (cons 62 3)
       )
   )
  (sssetfirst nil (setq MySS (ssget "_X" varf))) ;; ADDED A NAME TO THE SELECTION SET

(if MySS
  (progn

; Inverting selection 
  (if (ssget "_I")
    (progn; then
     (sssetfirst nil)
     (command "_.select" "_all" "_remove" (ssget "_p") "") ;; could also do 'remove' MySS
     (sssetfirst nil (ssget "_p"))
    ) ; end progn
    (prompt "\nRequires pre-selection."); else
  ) ; end if

; Delete Selection
  (command "_.erase")

; Insert Drawing Name 
  (and (or (> (getvar 'DWGTITLED) 0)
           (alert "Save the drawing then try again!")
       ) ; end or

      (setq acount 0)
      (while (< acount (sslength MySS))
        (setq ins (GetCentre (ssname MySS acount) ) )
        (setq str (MakeText ins (vl-filename-base (getvar "dwgname"))) )
        (setq acount (+ acount 1))
      ) ; end while

  ) ; end and

  ) ; end progn 'if MySS'
    (setq str (MakeText (list 0 0 0) (vl-filename-base (getvar "dwgname"))) )
  ) ; end if 'if MySS'
  (princ)
)

 

Edited by Steven P
  • Thanks 1
Link to comment
Share on other sites

14 minutes ago, Steven P said:

Try this one,  it should put the filename in all the green boxes (noting this includes the green box in the border), plus filename in the origin (0,0) - try it and see and let me know any comments

 

 

(defun C:foo ( / varf ins str MySS)
  ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/zoom-object-problem/td-p/5031146
  (defun GetCentre (ent / minPt maxPt ll ur inspt) ;; gets the centre of the entity bounding box-ish
    (vla-GetBoundingBox (vlax-ename->vla-object ent)
      'minPt
      'maxpt
    )
    (setq ll (car (cons (vlax-safearray->list minPt) ll))
          ur (car (cons (vlax-safearray->list maxPt) ur))
    )
    (setq inspt (list (/ (+ (car ll) (car ur)) 2) (/ (+ (cadr ll) (cadr ur)) 2)) )
  )

  (defun MakeText ( ins txt / )
    (entmakex (list '(0 . "MTEXT")
                    '(100 . "AcDbEntity")
                    '(100 . "AcDbMText")
                    (cons 10 (trans ins 1 0))
	            (cons 40   0.8);Text height
                    (cons 1 txt)
	            (cons 7   "STANDARD");Text style
                    '(1 . "")
              ) ; end list
    ) ; end entmakex
  ) ; end defun


;  Selecting Polyline
    (setq varf
      (list
        '(-4 . "<OR")
          '(0 . "LWPOLYLINE")
          '(-4 . "<AND")
            '(0 . "POLYLINE")
            '(-4 . "<NOT")
              '(-4 . "&")
              '(70 . 80)
            '(-4 . "NOT>")
          '(-4 . "AND>")
        '(-4 . "OR>")
        (cons 62 3)
       )
   )
  (sssetfirst nil (setq MySS (ssget "_X" varf))) ;; ADDED A NAME TO THE SELECTION SET

; Inverting selection 
  (if (ssget "_I")
    (progn; then
     (sssetfirst nil)
     (command "_.select" "_all" "_remove" (ssget "_p") "") ;; could also do 'remove' MySS
     (sssetfirst nil (ssget "_p"))
    ) ; end progn
    (prompt "\nRequires pre-selection."); else
  ) ; end if

; Delete Selection
  (command "_.erase")

; Insert Drawing Name 
  (and (or (> (getvar 'DWGTITLED) 0)
           (alert "Save the drawing then try again!")
       ) ; end or

      (setq acount 0)
      (while (< acount (sslength MySS))
        (setq ins (GetCentre (ssname MySS acount) ) )
        (setq str (MakeText ins (vl-filename-base (getvar "dwgname"))) )
        (setq acount (+ acount 1))
      ) ; end while

  ) ; end and

  (setq str (MakeText (list 0 0 0) (vl-filename-base (getvar "dwgname"))) )
  (princ)
)

 

 

 

all good except this. probably I didn't explain this part very well. adding filename in 0,0 must happen ONLY when there is some error. for example when there wasn't any green polyline in the loop.

Link to comment
Share on other sites

I've updated the code quickly - it will put the filename in if there are no green lines selected, I'll need to copy and paste in some proper error checking though to do anything other than that - will be later maybe

  • Like 1
Link to comment
Share on other sites

25 minutes ago, Steven P said:

I've updated the code quickly - it will put the filename in if there are no green lines selected, I'll need to copy and paste in some proper error checking though to do anything other than that - will be later maybe

I'm so sorry I called you Stephen back there. Thank you again Steven. Everything is working the way I wanted to.

  • Like 1
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...