LISP to insert a block based on text contents

[nj1105nj]

Hello all,

 

I've found a list that will replace text with a block, but I am looking to find a lisp that will place a block at a certain location based off of the text location. Finally it needs to be able to search text entities for the specific string of text "PP". Right now it will only work if the text perfectly matches "PP". Here is the LISP in question.

 

(defun c:txttoblk2( / ss e)
  (vl-load-com)
  (setq blk "TREE") ; Put block name here, with directory if block is not already in drawing
  (setq ss (ssget "X" '((0 . "TEXT")(1 . "N"))))
  (if ss
    (progn
      (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (mapcar '(lambda (x)
         (setq e (entget x))
         (entmake
           (append
             (list (cons 0 "INSERT") (cons 100 "AcDbEntity") (cons 100 "AcDbBlockReference")
               (cons 410 (cdr (assoc 410 e)))
               (cons 8 (cdr (assoc 8 e)))
               (cons 2 blk)
               (cons 10 (cdr (assoc 10 e)))
               (cons 41 (* (/ 1 3) (cdr (assoc 40 e))))
               (cons 42 (* (/ 1 3) (cdr (assoc 40 e))))
               (cons 50 (cdr (assoc 50 e))))
             )
           )
         (entdel x)) ss)
      )
    (princ "\nNo text entities found.")
    )
  (princ)
  )

 

[dlanorh]

Quote

Finally it needs to be able to search text entities for the specific string of text "PP". Right now it will only work if the text perfectly matches "PP".

 

You'll need to expand on this "PP" at the start of the text or anywhere in the text (could get false positives). Are you also trying to find "Pp", "pp" and "pP"?

 

[nj1105nj]

On 2/13/2020 at 4:08 PM, dlanorh said:

 

You'll need to expand on this "PP" at the start of the text or anywhere in the text (could get false positives). Are you also trying to find "Pp", "pp" and "pP"?

 

Currently the test in question is usually this "PP CAK9789". I need it to pick up that whole piece of text. Right now it wont recognize it because of the text at the end 

[dlanorh]

Try

 

(setq ss (ssget "X" '((0 . "TEXT")(1 . "PP*"))))

 

[nj1105nj]

On 2/16/2020 at 11:58 AM, dlanorh said:

Try

 

(setq ss (ssget "X" '((0 . "TEXT")(1 . "PP*"))))

 

that seemed to work great! Now the only thing to overcome is to figure out how to get the block to insert to a specific x and y offset from the text instead of replacing the text. Any ideas on how to accomplish that?

 

[dlanorh]

1 hour ago, nj1105nj said:

that seemed to work great! Now the only thing to overcome is to figure out how to get the block to insert to a specific x and y offset from the text instead of replacing the text. Any ideas on how to accomplish that?

 

 

If pt (x y z) is the point to be offset from then n_pt (new point to insert block) is

 

(setq n_pt (mapcar '+ pt (deltaX deltaY deltaZ)))

since this is an addition if deltaX deltaY or deltaZ are negative they will be subtracted.

[nj1105nj]

10 minutes ago, dlanorh said:

 

If pt (x y z) is the point to be offset from then n_pt (new point to insert block) is

 

(setq n_pt (mapcar '+ pt (deltaX deltaY deltaZ)))

since this is an addition if deltaX deltaY or deltaZ are negative they will be subtracted.

I tried this but it seems to be having the same outcome. What am I doing wrong here?

 

(defun c:ppreplace( / ss e)
  (vl-load-com)
  (setq blk "-ex pole") ; Put block name here, with directory if block is not already in drawing
  (setq ss (ssget "X" '((0 . "TEXT")(1 . "PP*"))))
  (if ss
    (progn
      (setq ss (setq n_pt (mapcar '+ pt (-.3084 .5931 .0))))
      (mapcar '(lambda (x)
         (setq e (entget x))
         (entmake
           (append
             (list (cons 0 "INSERT") (cons 100 "AcDbEntity") (cons 100 "AcDbBlockReference")
               (cons 410 (cdr (assoc 410 e)))
               (cons 8 (cdr (assoc 8 e)))
               (cons 2 blk)
               (cons 10 (cdr (assoc 10 e)))
               (cons 41 (* (/ 1 3) (cdr (assoc 40 e))))
               (cons 42 (* (/ 1 3) (cdr (assoc 40 e))))
               (cons 50 (cdr (assoc 50 e))))
             )
           )
         (entdel x)) ss)
      )
    (princ "\nNo text entities found.")
    )
  (princ)
)

[dlanorh]

2 hours ago, nj1105nj said:

I tried this but it seems to be having the same outcome. What am I doing wrong here?

 

(defun c:ppreplace( / ss e)
  (vl-load-com)
  (setq blk "-ex pole") ; Put block name here, with directory if block is not already in drawing
  (setq ss (ssget "X" '((0 . "TEXT")(1 . "PP*"))))
  (if ss
    (progn
      (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))

      (mapcar '(lambda (x)
         (setq e (entget x))
         (entmake
           (append
             (list (cons 0 "INSERT") (cons 100 "AcDbEntity") (cons 100 "AcDbBlockReference")
               (cons 410 (cdr (assoc 410 e)))
               (cons 8 (cdr (assoc 8 e)))
               (cons 2 blk)
               (cons 10 (mapcar '+  (cdr (assoc 10 e)) '( -0.3084 0.5931 0.0)))
               (cons 41 (* (/ 1 3) (cdr (assoc 40 e))))
               (cons 42 (* (/ 1 3) (cdr (assoc 40 e))))
               (cons 50 (cdr (assoc 50 e))))
             )
           )
         (entdel x)) ss)
      )
    (princ "\nNo text entities found.")
    )
  (princ)
)

 

Try the above. You only needed to change the insertion point (cons 10 (cdr (assoc 10 e))) for the block.

 

( -0.3084 0.5931 0.0) is not a list it could be considered as a function called -0.3084 with two arguements. A list should be '( -0.3084 0.5931 0.0) or (list  -0.3084 0.5931 0.0)

 

 

 

[nj1105nj]

13 minutes ago, dlanorh said:

 

Try the above. You only needed to change the insertion point (cons 10 (cdr (assoc 10 e))) for the block.

 

( -0.3084 0.5931 0.0) is not a list it could be considered as a function called -0.3084 with two arguements. A list should be '( -0.3084 0.5931 0.0) or (list  -0.3084 0.5931 0.0)

 

 

 

That seems to work as well, yet it is still replacing the text that it is inserting based off of. How would I keep the text?

[dlanorh]

remove the (entdel x) near the bottom, but ensure you keep the rest of the line   )ss)