Topic: Delete zero length lines in drawing

[hyposmurf]

Stumbled across this in a collection of old lisps I have.Anyone think its not a good idea to use?I might add it to my nulltext and purge macro.

Code: [Select]

;;; NAME OF FUNCTION: ZLL.LSP

(defun c:zll (/ ss e cnt key olderr)
(defun newerr (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(setq *error* olderr)
(princ)
)
(setq olderr *error*
*error* newerr
  )
  (prompt "\nAll zero length lines in database will be deleted. ")
(initget 1 "Yes No  ")

;; note trailing space after 'No'. Required so that a space is accepted
;; as a keyword by getkword.

(setq key (getkword "\nContinue? Y/N <Y>:"))
(cond
( (or (= key "Yes") (= key "")) ; "" is for spacebar response
(setq ss (ssget "x" (list (cons 0 "line"))) ; get all the lines
cnt 0 ; initialize while counter
tcnt 0 ; total entites removed
)
(if ss ; if lines, therefore ss
(while (< cnt (sslength ss))

;; continue as long as counter less than length of selection set

(setq e (ssname ss cnt) ; entity name
cnt (1+ cnt) ; add one to counter for next loop
)

;; equal must be used because we are comparing two lists. = is valid for
;; numbers and strings.

(if (equal (cdr (assoc 10 (entget e))) (cdr (assoc 11 (entget e))))
(progn
(entdel e)
(setq tcnt (1+ tcnt)) ;adds one for every entity deleted
)
)

;; inform the user that processing is in progress.

(prompt "\nWorking... ")
) ;end while
)
(prompt (strcat "\n" (itoa tcnt)
" zero length lines have been deleted. "
) ;give the total number of lines deleted
)
) ;end first cond. statement
( T
(prompt "\nNothing done. Well, thanks for stopping by anyway. ")
)
) ;end cond.
(setq *error* olderr) ; restore original error handler
(princ) ; clean ending
) ; end defun zll

[CAB]

At first glance it looks OK.
But doesn't check for frozen or locked layers.

[Jeff_M]

At first glance it looks OK.
But doesn't check for frozen or locked layers.

The lines on frozen layers will still be removed, but locked layers will throw it into a tizzy. Here is some sample code that I use to check for, remove & reset the lock status for layers.
Place this before any object maniplulating:

Code: [Select]

  (setq doc (vla-get-activedocument (vlax-get-acad-object))
lays (vla-get-layers doc)
)
  (vlax-for lay lays
    (if (eq (vla-get-lock lay) :vlax-true)
      (progn
(setq lokt (cons lay lokt))
(vla-put-lock lay :vlax-false)
)
      )
    )
then place this after any manipulation.

Code: [Select]

(if lokt
    (mapcar '(lambda (x)
       (vla-put-lock x :vlax-true)
       )
    lokt
    )
    )


[David Bethel]

Hypo

Using (equal) without a fuzz factor mean the point values must be exact, and I mean exact.  That can be a bit misleading the way 'puters and acad store real numbers. A fuzz factor of 1e-8 would erase any lines less than 0.00000001 units long and compare point values up t 1,000,000 units large.  _David

[whdjr]

This is one I wrote a while when some 'genius' in our office decided to explode some sand hatches.

Code: [Select]

(defun c:del_sand_hatch (/ ss num lst)
  (setq ss (ssget '((0 . "LINE"))))
  (repeat (setq num (sslength ss))
    (setq num (1- num)
  lst (cons (ssname ss num) lst)
    )
  )
  (setq lst (vl-remove-if-not
      '(lambda (x)
(setq x (entget x))
(equal (cdr (assoc 10 x)) (cdr (assoc 11 x)))
       )
      lst
    )
  )
  (mapcar 'entdel lst)
  (princ)
)

[whdjr]

I just tried mine and it doesn't work on locked items either. 

[Sdoman]

 

I just tried mine and it doesn't work on locked items either. 

In the case of prompting the user for a selection set, you can filter out locked layers by simply adding the ":L" option to the ssget arguments.

Code: [Select]

(setq ss (ssget ":L" '((0 . "LINE"))))