PDA

View Full Version : Anyone up for a LISP challenge?



Rroger_D
2015-07-25, 11:39 AM
Hi,

Here's one for all you budding LISP writers, if you fancy a challenge.......?

Auto-delete overlapping text.

In the past I have looked at addressing the drawing as a whole and all text on all layers using some form of weighting. However, I feel this may be too complicated. Instead, I suggest addressing a layer at a time.

The way I see it is:
- user isolates layer
- user selects multiple text entries on that layer
- the routine would then:
- gives all text items a label as 't1' 't2' 't3' etc
- draws bounding boxes around all text entries
- selects text item 't1'
- create a search area around text 't1' of radii 2x size of bounding box
- name every piece of text within this search as 's1' 's2' 's3' s4' etc
- check each in turn to see if bounding box of 's1' overlaps with box of 't1'
- if 's1' overlaps with 't1' then delete 's1'. If not, ignore
- if 's2' overlaps with 't1' then delete 's2'. if not, ignore
- repeat for all 's' items.
- return to main loop and check for item 't2'.
- repeat until all entries in selection have been checked.

I think that this is how it would work. I just haven't a clue how to write LISP.

What do ya think?

BIG thanks!

Rroger_D

Wanderer
2015-08-05, 04:27 PM
Hi,

Here's one for all you budding LISP writers, if you fancy a challenge.......?

Auto-delete overlapping text.

In the past I have looked at addressing the drawing as a whole and all text on all layers using some form of weighting. However, I feel this may be too complicated. Instead, I suggest addressing a layer at a time.

The way I see it is:
- user isolates layer
- user selects multiple text entries on that layer
- the routine would then:
- gives all text items a label as 't1' 't2' 't3' etc
- draws bounding boxes around all text entries
- selects text item 't1'
- create a search area around text 't1' of radii 2x size of bounding box
- name every piece of text within this search as 's1' 's2' 's3' s4' etc
- check each in turn to see if bounding box of 's1' overlaps with box of 't1'
- if 's1' overlaps with 't1' then delete 's1'. If not, ignore
- if 's2' overlaps with 't1' then delete 's2'. if not, ignore
- repeat for all 's' items.
- return to main loop and check for item 't2'.
- repeat until all entries in selection have been checked.

I think that this is how it would work. I just haven't a clue how to write LISP.

What do ya think?

BIG thanks!

Rroger_D

I've moved this from the AutoCAD tips and tricks forum to the LISP forum, as I believe it will be better served here.

Cheers.

Tom Beauford
2015-08-05, 04:58 PM
I've never put text in a drawing that didn't need to be there. The idea of creating code that randomly deletes text scares me. Sounds like you're creating a virus. What other purpose could something like this have?

peter
2015-08-06, 02:37 AM
I have no problem with routines finding overlapping entities, but I like to be given the opportunity to choose what to do with them.

This works a little differently than your functional specification.

It checks the active layout to see if there are any overlapping text.

It creates a previous selection set with any duplicate text entities and tells you how many it found.

You can decide what to do with them.

P=


;______________________________________________________________________________________________________________
;
; Overlaptext finds and creates a selection set of overlapping text entities
; Written by: Peter Jamtgaard copyright 2015
;______________________________________________________________________________________________________________

(defun C:OverLapText (/ lstSelections lstOfSublists lstOverlaps lstSublist1 lstSublist2 ssSelections strHandle)
(if (setq ssSelections (ssget "x" (list (cons 0 "text")(cons 410 (getvar "ctab")))))
(and
(setq lstSelections (SelectionSetToList ssSelections))
(setq lstSelections (mapcar 'vlax-ename->vla-object lstSelections))
(setq lstOfSublists (mapcar 'PropertyMatchList lstSelections))
(foreach lstSublist1 lstOfSublists
(setq lstOfSublists (vl-remove lstSublist1 lstOfSublists))
(foreach lstSublist2 lstOfSublists
(and (/= (car lstSublist1)(car lstSublist2))
(apply 'and (mapcar 'equal (cdr lstSublist1)(cdr lstSublist2)))
(setq strHandle2 (car lstSublist2))
(not (member strHandle2 lstOverlaps))
(setq lstOverlaps (cons strHandle2 lstOverlaps))

)
)
)
)
)
(if lstOverlaps
(progn
(listtoselectionset (mapcar 'handent lstOverlaps))
(princ (strcat "\n" (itoa (sslength (ssget "p")))))
(princ " pieces of Overlapping text are in previous selection set! ")
(prin1)
)
)
)

;______________________________________________________________________________________________________________
; Convert a list of entities to a selection set
;______________________________________________________________________________________________________________

(defun ListToSelectionSet (lstENames / entItem ssSelections)
(setq ssSelections (ssadd))
(foreach entItem lstENames (ssadd entItem ssSelections))
(command "select" ssSelections "")
)

;______________________________________________________________________________________________________________

; Convert a selection set to a list of entities
;______________________________________________________________________________________________________________

(defun SelectionSetToList (ssSelections / entSelection intCount objSelection lstReturn)
(repeat (setq intCount (sslength ssSelections))
(setq intCount (1- intCount))
(setq entSelection (ssname ssSelections intCount))
(setq lstReturn (cons entSelection lstReturn))
)
lstReturn
)

;______________________________________________________________________________________________________________

; Function to create a list of properties for a vla-object
;______________________________________________________________________________________________________________

(defun PropertyMatchList (objSelection)
(mapcar '(lambda (x)(vlax-get objSelection X))
(list 'handle 'textstring 'insertionpoint 'layer 'height 'stylename); <- This is where you can change the properties
)
)

(vl-load-com)

;______________________________________________________________________________________________________________