;Retourniert alle registrierten Anwendungen der Zeichnung in einer Liste:
(defun App_List (/ al)
  (setq al nil)
  (vlax-for ap
    (vla-get-RegisteredApplications
      (vla-get-ActiveDocument (vlax-Get-Acad-object))
    )
    (setq al (cons (vla-get-Name ap) al))
  )
  (reverse al)
)

;Von [oh] (Elementname oder dessen Handle in GC 5) werden alle referenzierenden
;Objekte gesammelt u. samt dem jew. Appl.-Namen in einer Ass.-Liste retourniert.
;("2355CF" (<Objektname: 7d4d31c8> "Linien-Signatur")
;          (<Objektname: 7d4d31d0> "Linien-Signatur")
;          (<Objektname: 7d4d31f0> "Grenz-Signatur") ... usw.)
;Damit kann die Funktion (ChangRef) ihnen w.n. über GC 1005 ein neues/anderes 
;Referenz-Objekt zuweisen.
(defun CatchRef (oh / rh rl oh as al en ed xd ap ad)
  (setq rh nil rl nil)
  (if (= (type oh) 'ENAME) (setq oh (cdr (assoc 5 (entget oh)))))
  (if (and (= (type oh) 'STR) (handent oh)) (setq rh (cons 1005 oh)))
  (if (and rh (setq as (ssget "_X" '((-3 ("*"))))))
      (progn
        (setq al (App_List))
        ;(dos_progbar "Referenzen:" (sslength as))
        (while (setq en (ssname as 0))
          ;(dos_progbar -1)
          (setvar "modemacro" (strcat "Referenzen: " (itoa (sslength as))))
          (setq ed (entget en al)
                xd (cdr (assoc -3 ed))
          )
          (foreach ad xd
            (setq ap (car ad)
                  ad (cdr ad)
            )
            (while (and ad (setq ad (member rh ad)))
              (setq rl (cons (list en ap) rl)
                    ad (cdr ad)
              )
            )
          )
          (ssdel en as)
        )
        ;(dos_progbar)
        (setvar "modemacro" ".")
        (princ (strcat "\n" (itoa (length rl)) " Referenzen gefunden.")) (princ)
        (cons oh rl)
      )
  )
)

;In den EEDs der Objekte aus der Referenzen-Liste [rl] wird der neue Handle [nh]
;mit GC 1005 ausgetauscht. [nh] kann auch ein Elementname sein.
(defun ChangRef (nh rl / nh ct oh ap ed od nd)
  (if (= (type nh) 'ENAME) (setq nh (cdr (assoc 5 (entget nh)))))
  (if (and (= (type nh) 'STR) (handent nh))
      (setq nh (cons 1005 nh))
      (setq nh nil)
  )
  (setq ct 0)
  (if nh
      (progn
        (setq oh (cons 1005 (car rl)))
        (foreach en (cdr rl)
          (setq ap (cdr en)
                ed (entget (car en) ap)
                od (assoc -3 ed)
                nd (cdadr od)
          )
          (if (member oh nd)
              (progn
                (setq nd (subst nh (assoc 1005 nd) nd)
                      nd (cons -3 (list (cons (car ap) nd)))
                      ed (subst nd od ed)
                      ct (1+ ct)
                )
                (entmod ed)
              )
          )
        )
      )
  )
  (princ (strcat "\n" (itoa ct) " Handles neu referenziert.")) (princ)
)

;Befehl zum Testen:
(defun C:ChangRef ()
  (if (and (setq ew (entsel "\nAltes Objekt klicken: "))
           (setq rl (CatchRef (car ew)))
           (setq ew (entsel "\nNeues Objekt klicken: "))
      )
      (ChangRef (car ew) rl)
  )
  (princ)
)

;Klont eine geklickte LW-Polylinie als 2D-Polylinie mit sämtlichen Objekt-
;Eigenschaften und ggf. anhängigen XDaten. Es werden ggf. auch alle anderen
;Objekte, die in ihren XDaten auf die LW-Polylinien verweisen, entsprechend
;korrigiert. Die alte Linie wird abschließend gelöscht.
;Es werden die Sub-Funktionen (App_List), (CatchRef) und (ChangRef) benötigt.
(defun C:LWpoly2D (/ ew en ed vl xd oh o1 pt ct o2 rl)
  (if (and (setq ew (entsel "\nLW-Polylinie wählen:"))
           (setq en (car ew))
           (setq ed (entget en (App_List)))
      )
      (if (= (cdr (assoc 0 ed)) "LWPOLYLINE")
          (progn      
            (setq vl nil
                  xd (assoc -3 ed)
                  oh (cdr (assoc 5 ed))
                  o1 (vlax-ename->vla-object en)
            )
            (while (setq pt (assoc 10 ed))
              (setq vl (cons
                         (list
                           (list (cadr pt) (last pt) 0.0)
                           (cdr (assoc 42 ed))
                         )
                         vl
                       )
                    ed (cdr (member pt ed))
              )
            )
            (setq ct 0
                  vl (reverse vl)
                  o2 (vla-Addpolyline
                       (vla-get-ModelSpace
                         (vla-Get-ActiveDocument (vlax-Get-Acad-object))
                       )
                       (vlax-make-variant
                         (vlax-safearray-fill
                           (vlax-make-safearray vlax-VbDouble
                             (cons 0 (1- (* 3 (length vl))))
                           )
                           (apply 'append (mapcar 'car vl))
                         )
                       )
                     )
            )
            (foreach pt vl
              (vla-setBulge o2 ct (cadr pt))
              (setq ct (1+ ct))
            )
            (vlax-put o2 'Closed (vlax-get o1 'Closed))
            (vlax-put o2 'Color (vlax-get o1 'Color))
            (vlax-put o2 'ConstantWidth (vlax-get o1 'ConstantWidth))
            (vlax-put o2 'Elevation (vlax-get o1 'Elevation))
            (vlax-put o2 'Layer (vlax-get o1 'Layer))
            (vlax-put o2 'Linetype (vlax-get o1 'Linetype))
            (vlax-put o2 'LinetypeScale (vlax-get o1 'LinetypeScale))
            (vlax-put o2 'Lineweight (vlax-get o1 'Lineweight))
            (vlax-put o2 'Normal (vlax-get o1 'Normal))
            (if (= (getvar "pstylemode") 0)
                (vlax-put o2 'PlotStyleName (vlax-get o1 'PlotStyleName))
            )
            (vlax-put o2 'Thickness (vlax-get o1 'Thickness))
            (vlax-put o2 'Visible (vlax-get o1 'Visible))
            (princ "\nNeue 2D-Polylinie erstellt.")
            (if xd
                (progn
                  (setq ed (entget (vlax-vla-object->ename o2))
                        ed (append ed (list xd))
                  )
                  (entmod ed)
                  (princ "\nXDaten übertragen.")
                )
            )
            (vla-Delete o1)
            (princ "\nLW-Polylinie gelöscht.")
            (vla-Update o2)
            (if (setq rl (CatchRef oh))
                (ChangRef (vlax-vla-object->ename o2) rl)
            )
          )
          (alert "Das ist keine LW-Polylinie !")
      )
  )
  (princ)
)
;Autoren: Joe Gauß und Mike Krüger, The Pointer Brothers