;;; - ------------------------------------------------------------------------------ - ;
;;; -                T O O L - A C M  - M P L C O N V E R T                          - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Beschreibung : Konvertiert Multilinien in entsprechende Polylinien             - ;
;;; - Befehle      : ML2PL                                                           - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - letzte Änderung am : 13.08.2024                                                - ;
;;; -              durch : Thomas Krüger                                             - ;
;;; - ------------------------------------------------------------------------------ - ;
(vl-load-com)
(defun C:ML2PL(/ AWS NOMUTT INDEX OBJ OBJLIST OLDCMD SUBLIST
               DT:UNDOEND DT:UNDOSTART DT:ERROR DT:INIT DT:RESET DT:ML2PL
              )
  (defun DT:UNDOEND()
    (while(= 8(logand 8 (getvar "undoctl")))
      (vla-endundomark(vla-get-activedocument(vlax-get-acad-object)))
    )      
  )
  (defun DT:UNDOSTART()
    (DT:UNDOEND)
    (vla-startundomark(vla-get-activedocument(vlax-get-acad-object)))
  )
  (defun DT:ERROR (MSG)    
    (if(not(wcmatch(strcase MSG t) "*break,*cancel*,*exit*"))      
      (princ (strcat "\nFEHLER: " MSG))
    )
    (DT:UNDOEND)
    (DT:RESET)
    (princ)
  )
  (defun DT:INIT()  
    (DT:UNDOSTART)        
    (setq ERRORSAVE *error*  *error* DT:ERROR
          NOMUTT(getvar "NOMUTT")
          OLDCMD(getvar "CMDECHO")
    )
  )
  (defun DT:RESET()
    (setvar "NOMUTT" NOMUTT)
    (setvar "CMDECHO" OLDCMD)
    (setq *error* ERRORSAVE)
    (mapcar '(lambda(X) (set X nil))(list 'ERRORSAVE))
    (DT:UNDOEND)
    (princ)
  )
  (defun DT:OBJEKT:GETOWNER(OBJ)
    (if(and(setq OBJ(cond
                      ((=(type OBJ)'ENAME)(vlax-ename->vla-object OBJ))
                      ((=(type OBJ)'VLA-OBJECT)OBJ)
                    )
           )      
           (setq OWNER
             (cond
              ((and(>(vl-string-search "x64"(getvar "PLATFORM"))0)
                   (vlax-method-applicable-p(vla-get-Document OBJ)"ObjectIdToObject32")
                   (vlax-property-available-p OBJ "ownerid32")
               )
                (vlax-invoke-method
                  (vla-get-Document OBJ)'ObjectIdToObject32(vla-get-ownerid32 OBJ)
                )
              )                     
              ('T
                (vlax-invoke-method
                  (vla-get-Document OBJ)'ObjectIdToObject(vla-get-ownerid OBJ)
                )
              )
             )  
           )
       )
      OWNER
    )
  )
  (defun DT:GETAKTIVESPACE()
    (if(=(vla-get-activespace(vla-get-activedocument(vlax-get-acad-object)))
         acPaperSpace
       )   
      (vla-get-paperspace
         (vla-get-activedocument(vlax-get-acad-object))
      )
      (vla-get-modelspace
         (vla-get-activedocument(vlax-get-acad-object))
      )
    )
  )
  (defun DT:ML2PL (OBJ DELETE?
                  / OBJOWNER ASPACE COPYOBJ LASTOBJ AUSWAHL PLLIST RETURN
                  )
    (if(and(setq OBJ(cond
                      ((=(type OBJ) 'VLA-OBJECT) OBJ)
                      ((=(type OBJ) 'Ename) (vlax-ename->vla-object OBJ))
                    )
           )
           (=(strcase(vla-get-Objectname OBJ))"ACDBMLINE")
           (=(vla-get-active(vla-get-document OBJ)):vlax-true)
           (setq OBJOWNER(DT:OBJEKT:GETOWNER OBJ))
           (setq ASPACE(DT:GETAKTIVESPACE))
           (if(not(equal ASPACE OBJOWNER))
             (not(vl-catch-all-error-p 
                   (setq COPYOBJ
                     (vl-catch-all-apply
                       'vla-CopyObjects
                        (list(vla-get-ActiveDocument(vlax-get-acad-object))
                             (vlax-make-variant
                               (vlax-safearray-fill
                                 (vlax-make-safearray vlax-vbObject '(0 . 0)) 
                                   (list OBJ)
                                 )
                               )
                               (vlax-make-variant
                                  ASPACE
                               )
                        )  
                     )  
                   )
                 )
             )
             (not(vl-catch-all-error-p 
                   (setq COPYOBJ
                     (vl-catch-all-apply
                       'vla-CopyObjects
                        (list(vla-get-ActiveDocument(vlax-get-acad-object))
                             (vlax-make-variant
                               (vlax-safearray-fill
                                 (vlax-make-safearray vlax-vbObject '(0 . 0)) 
                                   (list OBJ)
                                 )
                               )
                        )  
                     )  
                   )
                 )
             )
           )  
           (setq COPYOBJ(car(vlax-safearray->list(vlax-variant-value COPYOBJ))))
           (setq LASTOBJ (entlast))
           (or(not(vl-catch-all-error-p
                    (vl-catch-all-apply
                      'vl-cmdf (list "_.explode" (vlax-vla-object->ename COPYOBJ))
                    )
                  )
              )
              (and(not(vl-catch-all-error-p
                        (vl-catch-all-apply
                          'vla-delete (list COPYOBJ)
                        )
                      )
                  )
                  nil
              )
           )
       )    
      (progn
        (setq AUSWAHL(ssadd))
        (while(setq LASTOBJ(entnext LASTOBJ))(ssadd LASTOBJ AUSWAHL))      
        (if(and(>(sslength AUSWAHL)0)
               (setq LASTOBJ(entlast))
               (not(vl-catch-all-error-p
                     (vl-catch-all-apply
                       'vl-cmdf
                       (list "_.pedit" "_M" AUSWAHL "" "_J" "" "") 
                     )
                   ) 
               )     
           )
          (progn
            (while(setq LASTOBJ(entnext LASTOBJ))
              (setq PLLIST(cons LASTOBJ PLLIST))
            )
            (and PLLIST
                 (setq PLLIST(mapcar 'vlax-ename->vla-object PLLIST))
                 (not(vl-catch-all-error-p 
                       (setq RETURN
                         (vl-catch-all-apply
                           'vla-CopyObjects
                            (list(vla-get-ActiveDocument(vlax-get-acad-object))
                                 (vlax-make-variant
                                   (vlax-safearray-fill
                                     (vlax-make-safearray vlax-vbObject (cons 0  (1-(length PLLIST))))
                                     PLLIST
                                   )
                                 )
                                 (vlax-make-variant OBJOWNER)
                            )       
                         )
                       )
                    )  
                 )
                 (setq RETURN(vlax-safearray->list(vlax-variant-value RETURN)))
                 (mapcar
                   '(lambda(X)
                      (not(vl-catch-all-error-p
                            (vl-catch-all-apply
                              'vla-delete (list X)
                            )
                          )
                      )
                    )
                   PLLIST
                 )
                 (or(not DELETE?)
                    (not(vl-catch-all-error-p
                          (vl-catch-all-apply
                           'vla-delete (list OBJ)
                          )
                        )
                    )
                 )   
            )
          )
        )  
      )      
    ) 
    RETURN      
  )
  (DT:INIT)
  (if(or(setq AWS (ssget "_I" '((0 . "MLINE"))))
        (and(setq NOMUTT(getvar "NOMUTT"))
            (setvar "NOMUTT" 1)
            (princ "\nUmzuwandelne MultiLinien wählen: ")
            (or(vl-catch-all-error-p
                 (setq AWS(vl-catch-all-apply
                            'ssget (list '((0 . "MLINE")))
                          ) 
                 )
               )               
               'T
            )
            (setvar "NOMUTT" NOMUTT)
            (or(=(type AWS)'PICKSET)
               (prompt "\nAbbruch durch Anwender...")
            )   
            (>(sslength AWS)0)
        )
        (prompt "\nKeine MultiLinien gewählt")
     )
    (progn      
      (setq INDEX -1)
      (repeat(sslength AWS)        
        (if(setq OBJ(ssname AWS (setq INDEX(1+ INDEX))))
          (setq OBJLIST (cons OBJ OBJLIST))       
        )
      )
      (setvar "CMDECHO" 0)
      (if(setq OBJLIST(vl-remove-if 'null (mapcar
                                           '(lambda(X)(DT:ML2PL X 'T))
                                            OBJLIST
                                          )  
                      )
         )
        (progn
          (setq AWS (ssadd))
          (foreach SUBLIST OBJLIST
            (foreach OBJ SUBLIST
              (if(setq OBJ(vlax-vla-object->ename OBJ))
                (ssadd OBJ AWS)
              )  
            )
          )  
          (sssetfirst AWS AWS)   
        )          
      )  
      (princ)
    )  
  )
  (DT:RESET)
)
;;; - ------------------------------------------------------------------------------- - ;
(defun ACM-MPLCONVERT:INFO() 
  (mapcar
    'princ
    (list
      "\n\n"
      "\nACM-MPLCONVERT : Konvertiert Multilinien in entsprechende Polylinien"
      "\n============== "
      "\n(C) Thomas Krüger 2024 (tk@cad-od.de)"
      "\nBefehlszeilenaufrufe : ML2PL\n"
      "\n"    
    )
  )
  (princ)  
)
;;; - ------------------------------------------------------------------------------- - ;
(ACM-MPLCONVERT:INFO)
