;| acmDeleteDuplicateSolids

Löschen von deckungsgleichen Volumenkörpern mit der Option,
unterschiedliche Layer und Materialien zu ignorieren.

Plattform: ab AutoCAD 2020

Copyright
Markus Hoffmann, www.CADmaro.de

Mai 2023
|;
(defun c:acmDeleteDuplicateSolids (/ c ss l lSolidData lOneSolid lEquals)
  (mx:Init)
  (if
    (setq ss (ssget '((0 . "3DSOLID"))))
     (progn
       (setq l (mx:SettingsDCL))
       (setq *sSolidLayer* (cadr (assoc "Layer" l)))
       (setq *sSolidMaterial* (cadr (assoc "Material" l)))
       (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
                        (if (= "1" *sSolidLayer*)
                          't
                          (equal
                            (nth 3 lOneSolid)
                            (nth 3 x)
                          )             ; Layer
                        )
                        (if (= "1" *sSolidMaterial*)
                          't
                          (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 "\nKeine 3D-Volumenkörper gefunden.")
  )
  (princ
    (strcat
      "\n"
      (itoa c)
      " doppelte 3D-Solids gelöscht."
    )
  )
  (mx:Reset)
  (princ)
)

 ;| mx:SettingsDCL

Dialog zum Setzen von LAYISO-Einstellungen
|;
(defun mx:SettingsDCL (/ sDCLfile dclID ddiag lTiles)
  (MakeDCL:DeDuSo
    (setq sDCLfile
           (strcat
             (getvar "TEMPPREFIX")
             "mxViLayIso.dcl"
           )
    )
  )
  (setq dclID (load_dialog sDCLfile))
  (if
    (new_dialog "mxDeDuSo" dclID)
     (progn
       (set_tile "Layer" (cond (*sSolidLayer*)("1")))
       (set_tile "Material" (cond (*sSolidMaterial*)("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
              )
       )
     )
    '("Layer" "Material")
  )
  l
)

 ;| MakeDCL:DeDuSo

Erzeugt ein Dialog für die Einstellungen des LAYISO-Dialogs
|;
(defun MakeDCL:DeDuSo (sDCLfile / f)
  (setq f (open sDCLfile "w"))
  (mapcar
    '(lambda (s)
       (write-line s f)
     )
    (list
      "mxDeDuSo:dialog{"
      "label=\"acmDeleteDuplicateSolids\";"
      ": boxed_row {"
      "label = \"Unterschiedliche Einstellungen ignorieren für:\";"
      ": toggle {"
      "key = \"Layer\";"
      "label = \"Layer der Volumenkörper\";"
      "value = \"0\";"
      "}"
      ": toggle {"
      "key = \"Material\";"
      "label = \"Material der Volumenkörper\";"
      "value = \"0\";"
      "}"
      "}"
      "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
            )
     )
  )
)

 ;| 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 *sSolidLayer* (cond (*sSolidLayer*)("0")))
  (setq *sSolidMaterial* (cond (*sSolidMaterial*)("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:acmDeDuSo () (c:acmDeleteDuplicateSolids))

;; Feedback beim Laden
(princ
  "\nacmDeleteDuplicateSolids wurde geladen. Copyright M.Hoffmann, www.CADmaro.de.
Start mit \"acmDeleteDuplicateSolids\" oder \"acmDeDuSo\"."
)
(princ)