;| acmOverOverkill

Startet OVERKILL in allen Blöcken und auf Wunsch in allen Layouts und Modellbereich

Plattform: ab AutoCAD 2022

Copyright
Markus Hoffmann, www.CADmaro.de

August, 2024
|;
(defun c:acmOverOverkill (/ l sCurr done)
  (mx:Init)
  (if
    (setq l (mx:SettingsDCL))
     (progn
       (setq *sAktuell* (cadr (assoc "Aktuell" l)))
       (setq *sAlle* (cadr (assoc "Alle" l)))
       (cond
	 ((= "1" *sAlle*)
	  (setq sCurr (getvar 'CTAB))
	  (mapcar
	    '(lambda (s)
	       (setvar 'CTAB s)
	       (command-s "_pspace")
	       (mx:OverOverkill)
	     )
	    (layoutlist)
	  )
	  (setvar 'ctab "Model")
	  (mx:OverOverkill)
	  (setvar 'CTAB sCurr)
	 )
	 ((= "1" *sAktuell*)
	  (if (= acPaperSpace (vlax-get-property oad 'ActiveSpace))
	    (command-s "_pspace")
	  )
	  (mx:OverOverkill)
	 )
       )
     )
     (princ "\nAbbruch.")
  )
  (mx:Reset)
  (princ)
)

;| mx:OverOverkill

Die eigentliche Funktion
|;
(defun mx:OverOverkill (/ l)
  (command-s "_.-overkill" "_all" "" "_Done")
  (mx:OverkillSolids)
  (if (not done)
    (progn
      (vlax-for	oBlock (vla-get-blocks oAD)
	(if
	  (and
	    (= :vlax-false (vla-get-IsLayout oBlock))
	    (= :vlax-false (vla-get-IsDynamicBlock oBlock))
	    (= :vlax-false (vla-get-IsXRef oBlock))
	    (vlax-write-enabled-p oBlock)
	    (not (wcmatch (vla-get-Name oBlock) "`*@*"))
	  )
	   (setq l (cons (vla-get-Name oBlock) l))
	)
      )
      (foreach n l
	(command-s "_.-bedit" n)
	(command-s "_.-overkill" "_all" "" "_Done")
	(command-s "_.bsave")
	(command-s "_.bclose")
      )
    )
  )
  (if l
    (progn
      (princ
	(strcat "\n" (itoa (length l)) " Blöcke bereinigt.")
      )
      (setq done 'T)
    )
  )
)

;| mx:OverkillSolids

Bereinigt redundante 3D-Volumenkörper
|;
(defun mx:OverkillSolids (/ c ss l lSolidData lOneSolid lEquals)
  (setq c 0)
  (if
    (setq ss (ssget "X" '((0 . "3DSOLID"))))
     (progn
       (mapcar
	 '(lambda (e / o)
	    (setq o (vlax-ename->vla-object e))
	    (setq lSolidData
		   (cons
		     (list
		       (vla-get-Volume o)
		       (vla-get-Centroid o)
		       (vlax-safearray->list
			 (vlax-variant-value
			   (vla-get-PrincipalDirections o)
			 )
		       )
		       (vla-get-Layer o)
		       (vla-get-Material o)
		       e
		     )
		     lSolidData
		   )
	    )
	  )
	 (mx:SelectionSet->EList ss)
       )
       (setq lSolidData
	      (vl-sort lSolidData
		       '(lambda	(r j)
			  (< (car r) (car j))
			)
	      )
       )
       (while
	 (setq lOneSolid (car lSolidData))
	  (setq lSolidData (cdr lSolidData))
	  (setq	lEquals
		 (vl-remove-if-not
		   '(lambda (x)
		      (and
			(equal
			  (nth 0 lOneSolid)
			  (nth 0 x)
			  1e-4
			)		; Volume
			(equal
			  (nth 1 lOneSolid)
			  (nth 1 x)
			  1e-4
			)		; Centroid
			(equal
			  (nth 2 lOneSolid)
			  (nth 2 x)
			  1e-4
			)		; PrincipalDirections
			(equal
			  (nth 3 lOneSolid)
			  (nth 3 x)
			)		; Layer
			(equal
			  (nth 4 lOneSolid)
			  (nth 4 x)
			)		; Material
		      )
		    )
		   lSolidData
		 )
	  )
	  (mapcar
	    '(lambda (x)
	       (entdel (last x))
	       (setq lSolidData
		      (vl-remove x lSolidData)
	       )
	       (setq c (1+ c))
	     )
	    lEquals
	  )
       )
       (princ
	 (strcat
	   "\n"
	   (itoa c)
	   " doppelte 3D-Solids gelöscht."
	 )
       )
     )
  )
)

 ;| mx:SettingsDCL

Dialog zum Setzen von Einstellungen
|;
(defun mx:SettingsDCL (/ sDCLfile dclID ddiag lTiles)
  (MakeDCL:mxOOkill
    (setq sDCLfile
	   (strcat
	     (getvar "TEMPPREFIX")
	     "mxOOkill.dcl"
	   )
    )
  )
  (setq dclID (load_dialog sDCLfile))
  (if
    (new_dialog "mxOOkill" dclID)
     (progn
       (set_tile "Aktuell"
		 (cond (*sAktuell*)
		       ("1")
		 )
       )
       (set_tile "Alle"
		 (cond (*sAlle*)
		       ("1")
		 )
       )
       (action_tile
	 "accept"
	 "(setq lTiles (mx:GetTiles))(done_dialog 1)"
       )
       (action_tile "cancel" "(done_dialog 0)")
       (setq ddiag (start_dialog))
       (unload_dialog dclID)

     )
  )
  (vl-file-delete sDCLfile)
  lTiles
)

 ;| mx:GetTiles

liest Dialogfeldbuttons aus
|;
(defun mx:GetTiles (/ l)
  (mapcar
    '(lambda (s)
       (setq l
	      (cons
		(list
		  s
		  (get_tile s)
		)
		l
	      )
       )
     )
    '("Aktuell" "Alle")
  )
  l
)

 ;| MakeDCL:mxOOkill

Erzeugt ein Dialog für die Einstellungen des Befehls acmOverOverkill
|;
(defun MakeDCL:mxOOkill	(sDCLfile / f)
  (setq f (open sDCLfile "w"))
  (mapcar
    '(lambda (s)
       (write-line s f)
     )
    (list
      "mxOOkill:dialog{"
      "label=\"acmOverOverkill\";"
      ": radio_column {"
      "label = \"Befehl durchführen in:\";"
      " key = \"Bereich\";"
      ": radio_button {"
      "key = \"Aktuell\";"
      "label = \"Aktuellem Bereich\";"
      "}"
      ": radio_button {"
      "key = \"Alle\";"
      "label = \"Modellbereich und alle Layouts\";"
      "}"
      "}"
      "spacer_1;"
      "ok_cancel;"
      "}"
     )
  )
  (close f)
)

 ;| mx:SelectionSet->EList

Auswahlsatz in Liste umwandeln
|;
(defun mx:SelectionSet->EList (ss / c lst)
  (repeat
    (setq c (sslength ss))
     (setq lst
	    (cons
	      (ssname ss (setq c (1- c)))
	      lst
	    )
     )
  )
)

 ;| ST:ActiveSpace

gibt den aktiven Bereich zurück.
Papier oder Modell bzw. Modell im Papier
|;
(defun mx:ActiveSpace (/ space)
  (if
    (= acModelSpace (vlax-get-property oAD 'ActiveSpace))
     (setq space (vlax-get-property oAD 'ModelSpace))
     (if (= :vlax-true (vlax-get-property oAD 'MSpace))
       (setq space (vlax-get-property oAD 'ModelSpace))
       (setq space (vlax-get-property oAD 'PaperSpace))
     )
  )
  space
)

 ;| mx:Init

Initialisierung
|;
(defun mx:Init ()
  (vl-load-com)
  (setq oA (vlax-get-acad-object))
  (setq	oAD
	 (vlax-get-property
	   oA
	   'ActiveDocument
	 )
  )
  (setq iEcho (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq c 0)
  (setq	*sAktuell*
	 (cond (*sAktuell*)
	       ("0")
	 )
  )
  (setq	*sAlle*
	 (cond (*sAlle*)
	       ("0")
	 )
  )
  (setq	errorMX	*error*
	*error*	mx:Error
  )
  (vlax-invoke-method oAD 'EndUndomark)
  (vlax-invoke-method oAD 'StartUndomark)
)

 ;| mx:Reset

Zurücksetzen
|;
(defun mx:Reset	()
  (vla-regen oAD acAllViewports)
  (setq c nil)
  (setvar "CMDECHO" iEcho)
  (vlax-invoke-method oAD 'EndUndomark)
  (vlax-release-object oAD)
  (vlax-release-object oA)
  (setq *error* errorMX)
  (mapcar
    '(lambda (arg)
       (set
	 arg
	 'nil
       )
     )
    (list 'errorMX 'iEcho 'oAD 'oA 'lSelected)
  )
)

 ;| mx:Error

Errorfunktion
|;
(defun mx:Error	(s)
  (print (strcat "Fehler " s))
  (command-s)
  (command-s
    "_.undo"
    "_back"
  )
  (mx:Reset)
  (princ)
)

;;; Kurzbefehl
(defun c:acmOOk () (c:acmOverOverkill))

;; Feedback beim Laden
(princ
  "\nacmOveroverkill wurde geladen. Copyright M.Hoffmann, www.CADmaro.de.
Start mit \"acmOverOverkill\" oder \"acmOOk\"."
)
(princ)