;;;----------------------------------------------------------------------------|
;;;- Funktion:                lt-attsync                                       |
;;;----------------------------------------------------------------------------|
;;;- Author:                  Martin Harrer                                    |
;;;                           animalhouse@gmx.at                               |
;;;----------------------------------------------------------------------------|
;;;- Zweck:                   emuliert den attsync-Befehl der Vollversion      |
;;;----------------------------------------------------------------------------|
;;;- Datum:                   21.1.2009                                        |
;;;--------------------------------------------------------------------------- |
;;;- Bugs:                    keine bekannten                                  |
;;;--------------------------------------------------------------------------- |
;;;- Argumente:               keine                                            |
;;;--------------------------------------------------------------------------- |
;;;Benutzung auf eigene Gefahr, bei Bugs oder Sonderwünchen bitte mail         |
;;;----------------------------------------------------------------------------|


(defun c:lt-attsync (/ oldblk sset blk blkdata counter value)
  
;;;Undom begin:
  (command "_.undo" "_G")

;;;Layer sichern:
(Setq oldlayer (getvar "CLAYER"))
  
;;;Blocknamen des zu synchronisierenden Blocks holen:
  (setq	oldblk	(cdr (assoc 2 (entget (Car (entsel)))))
	
;;;Selectionset mit allen zu synchronisierenden Inserts bilden:
	sset	(ssget "_X" (list (cons 2 oldblk)))

	counter	0

  )

  (repeat (sslength sset)

    (Setq blk	  (ssname sset counter)

	  blkdata (entget blk)

    )

 ;;;Layer vom Insert übernehmen:
(setvar "CLAYER" (cdr (assoc 8 blkdata)))
    
;;;neuen Block einfügen:
    (command "_-INSERT"

	     oldblk

	     (cdr (assoc 10 blkdata))

	     1

	     1

	     (cdr (assoc 50 blkdata))

    )
    

;;;Attwerte von alten auf neuen Block übertragen:
    (foreach elem (getattlist (entlast))

      (if (setq value (getattrib blk elem))

	(setattrib (entlast) elem value)

      )

    )
    
;;;alten Block löschen:
    (entdel blk)

    (Setq counter (1+ counter))

  )

;;;alten Layer wiederherstellen:
(setvar "CLAYER" oldlayer)
  
;;;undo end:
(command "_.undo" "_E")
  
  (princ);Quiet exit

)


;;;----------------------------------------------------------------------------|
;;;- Funktion:                getattlist                                       |
;;;----------------------------------------------------------------------------|
;;;- Author:                  Martin Harrer                                    |
;;;                           animalhouse@gmx.at                               |
;;;----------------------------------------------------------------------------|
;;;- Zweck:                   gibt Liste mit Attributstags eines Blocks        |
;;;-                          zurück                                           |
;;;----------------------------------------------------------------------------|
;;;- Datum:                   21.1.2009                                        |
;;;--------------------------------------------------------------------------- |
;;;- Effekt:                  Liste mit Attributstags (Strings),               |
;;;                           nil wenn keine Attribute                         |
;;;----------------------------------------------------------------------------|
;;;- Seiteneffekt:            keiner                                           |
;;;----------------------------------------------------------------------------|
;;;- Bugs:                    keine bekannten                                  |
;;;--------------------------------------------------------------------------- |
;;;- Argumente:               block (car(entsel))                              |
;;;--------------------------------------------------------------------------- |

(defun getattlist (blname / att return attdata)

;;;Wenn Block keine Attribute hat --> entnext = nil --> Liste mit nil
;;;zurückgeben.
  (if

    (setq att (entnext blname))

;;;Übertragen der Attributstags in Rückgabeliste:
     (while (= (cdr (assoc 0 (setq attdata (entget att)))) "ATTRIB")

       (setq return (cons (cdr (assoc 2 attdata)) return)

	     att     (entnext att)

       )

     )

  )

  return

)

;;;----------------------------------------------------------------------------


(princ "\nlt-attsync erfolgreich geladen")
(princ "\nStart mit \"lt-attsync\"")

;;;---------------------------------------------------------------------------|
;;;- Funktion:                getattrib                                       |
;;;---------------------------------------------------------------------------|
;;;- Autor:                   Martin Harrer                                   |
;;;---------------------------------------------------------------------------|
;;;- Zweck:                   gibt den Attributswert des Blocks "block mit dem|
;;;-                          Attributsnamen "attname" zurück (als String     |
;;;---------------------------------------------------------------------------|
;;;- Datum:                   29.11.97                                        |
;;;---------------------------------------------------------------------------|
;;;- Effekt:                  string mit Attributswert, nil wenn Attribut     |
;;;                           nicht vorhanden                                 |
;;;---------------------------------------------------------------------------|
;;;- Seiteneffekt:            keiner                                          |
;;;---------------------------------------------------------------------------|
;;;- Bugs:                    keine bekannt                                   |
;;;---------------------------------------------------------------------------|
;;;- Argumente:               block (entityname) attname (string)             |
;;;---------------------------------------------------------------------------|
;;;ACHTUNG! Bei Übergabe des Attributnamens muß auf Groß und Kleinschreibung  |
;;;         geachtet werden!!!!                                               |
;;;---------------------------------------------------------------------------|
;;;---------------------------------------------------------------------------|
(defun getattrib (block attname / attrib retval)
  

  (if
  (Setq attrib (entnext block))
	

  (while (= (cdr (assoc 0 (entget attrib))) "ATTRIB")

    (if	(= (cdr (assoc 2 (entget attrib))) attname)

      (Setq retval (cdr (assoc 1 (entget attrib))))

    )

    (Setq attrib (entnext attrib))

  )
  )

  retval

)



;;;---------------------------------------------------------------------------|
;;;- Funktion:                setattrib                                       |
;;;---------------------------------------------------------------------------|
;;;- Autor:                   Martin Harrer                                   |
;;;---------------------------------------------------------------------------|
;;;- Zweck:                   schreibt attwert (string) in das Attribut       |
;;;-                          attname (String) des Blocks block (entityname). |
;;;---------------------------------------------------------------------------|
;;;- Datum:                   28.11.97                                        |
;;;---------------------------------------------------------------------------|
;;;- Effekt:                  T wenn erfolgreich, nil wenn nicht              |
;;;---------------------------------------------------------------------------|
;;;- Seiteneffekt:            schreiben des Attributwertes                    |
;;;---------------------------------------------------------------------------|
;;;- Bugs:                    keine bekannten                                 |
;;;---------------------------------------------------------------------------|
;;;- Argumente:               block (entityname) attname (string)             |
;;;                           attwert (String)                                |
;;;---------------------------------------------------------------------------|


(defun setattrib (block attname attwert / retval attrib )

  (if

  (setq attrib (entnext block))
	

  (while (= (cdr (assoc 0 (entget attrib))) "ATTRIB")

    (if	(= (cdr (assoc 2 (entget attrib))) attname)

      (progn

	(entmod	(subst (cons 1 attwert)

		       (assoc 1 (entget attrib))

		       (entget attrib)

		)

	)

	(entupd block)

	(setq retval T)

      )

    )

    (Setq attrib (entnext attrib))

)

  )

  (entupd block)

  retval

)