Hallo,
vor langer Zeit habe ich mir mal eine LISP-Routine geschrieben die Elemente wie Linien, Bögen, Kreise usw. auf eine bestimmte Einfügehöhe verschiebt. Das war noch unter AutoCAD 2006. Mit dem Wechsel auf AutoCAD 2012 klappt das Verschieben der Kreise leider nicht mehr. Allen anderen Elemente wie Linien, Böden usw. werden wie gewünscht verschoben.
Das Verschieben der Element erfolgt im Reactor :vlr-CommandWillStart Funktion: before bzw. :VLR-OBJECTAPPENDED . workElement
Die Funktion >workElement< setzt dann die Z-Koordinate auf den gewünschten Wert. Beim Element "CIRCLE" scheint mir der DXF Group codes 10 zu dem Zeitpunkt nicht mehr gefüllt zu sein... Wie kann das sein? Hat jemand eine Idee was ich machen kann?
Schon mal BESTEN DANK für eure Hilfe!!
Hier mein Code:
#############################################################################################################
; Schaltet einen Layers innerhalb einer
; Callback-Funktionen ein.
(defun todo_Reaktor (todoName / i)
(setq i 0)
(setq s todoName)
; Zeiger auf aktuelle Dokument
(setq acadDocument (vla-get-activedocument (vlax-get-acad-object)))
; Alle Layer holen
(setq Layers (vla-get-layers acadDocument))
; Schleife über alle Layer
(repeat (vla-get-count Layers)
(setq aLayer (vla-item Layers i))
; Name auslesen
(setq aName (vla-get-Name aLayer))
; finden wir den Layer >*name*< in der Liste...
(if (= aName s)
; und wir tauen den Layer
(vla-put-freeze aLayer :vlax-false)
);endif
(setq i (1+ i))
);repeat
);endLayerMap
#############################################################################################################
; vor dem Befehl....
(defun before (reatyp befname / )
(cond
((wcmatch (car befname) "XLINE")
; den aktuellen Layer holen
(setq *oldlay* (getvar "CLAYER"))
(setq DEFUN_SETZ (VLR-ACDB-REACTOR "DEFUN_SETZ"
'((:VLR-OBJECTAPPENDED . workElement)))
);endsetq
; den zu setzenden Layer holen
(setq *name* (nth 0 layerNew))
; Layer vorab einschalten
(todo_Reaktor *name*)
; Layer setzen
(setvar "CLAYER" *name*)
)
((wcmatch (car befname) "DIM*")
; den aktuellen Layer holen
(setq *oldlay* (getvar "CLAYER"))
; merker für workDimension
(setq imerk nil)
(setq DEFUN_DIMENSION (VLR-ACDB-REACTOR "DEFUN_DIMENSION"
'((:VLR-OBJECTAPPENDED . workDimension)))
);endsetq
(if (/= *oldlay* "0")
(progn
; den zu setzenden Layer holen
(setq ret2 (length layerBlae))
(while (not (zerop ret2))
(setq ret2 (1- ret2))
(setq merk (nth ret2 layerBlae))
(if (= (wcmatch merk "*BEM") T) (setq *name* merk))
)
; Layer vorab einschalten
(todo_Reaktor *name*)
; Layer setzen
(setvar "CLAYER" *name*)
)
);endIF
);endDIM
((wcmatch (car befname) "MTEXT")
; den aktuellen Layer holen
(setq *oldlay* (getvar "CLAYER"))
(setq DEFUN_SETZ (VLR-ACDB-REACTOR "DEFUN_SETZ"
'((:VLR-OBJECTAPPENDED . workElement)))
);endsetq
(if (/= *oldlay* "0" and /= *oldlay* "SPECIAL_GESBEM")
(progn
; den zu setzenden Layer holen
(setq ret2 (length layerBlae))
(while (not (zerop ret2))
(setq ret2 (1- ret2))
(setq merk (nth ret2 layerBlae))
(if (= (wcmatch merk "*BEM") T) (setq *name* merk))
)
; Layer vorab einschalten
(todo_Reaktor *name*)
; Layer setzen
(setvar "CLAYER" *name*)
)
);endIF
);endLINE
((wcmatch (car befname) "LEADER")
; den aktuellen Layer holen
(setq *oldlay* (getvar "CLAYER"))
(setq DEFUN_SETZ (VLR-ACDB-REACTOR "DEFUN_SETZ"
'((:VLR-OBJECTAPPENDED . workElement)))
);endsetq
(if (/= *oldlay* "0")
(progn
; den zu setzenden Layer holen
(setq ret2 (length layerBlae))
(while (not (zerop ret2))
(setq ret2 (1- ret2))
(setq merk (nth ret2 layerBlae))
(if (= (wcmatch merk "*BEM") T) (setq *name* merk))
)
; Layer vorab einschalten
(todo_Reaktor *name*)
; Layer setzen
(setvar "CLAYER" *name*)
)
);endIF
);endLEADER
((wcmatch (car befname) "QLEADER")
; den aktuellen Layer holen
(setq *oldlay* (getvar "CLAYER"))
(setq DEFUN_SETZ (VLR-ACDB-REACTOR "DEFUN_SETZ"
'((:VLR-OBJECTAPPENDED . workElement)))
);endsetq
(if (/= *oldlay* "0")
(progn
; den zu setzenden Layer holen
(setq ret2 (length layerBlae))
(while (not (zerop ret2))
(setq ret2 (1- ret2))
(setq merk (nth ret2 layerBlae))
(if (= (wcmatch merk "*BEM") T) (setq *name* merk))
)
; Layer vorab einschalten
(todo_Reaktor *name*)
; Layer setzen
(setvar "CLAYER" *name*)
)
);endIF
);endQLEADER
((wcmatch (car befname) "BHATCH")
; den aktuellen Layer holen
(setq *oldlay* (getvar "CLAYER"))
(setq DEFUN_SETZ (VLR-ACDB-REACTOR "DEFUN_SETZ"
'((:VLR-OBJECTAPPENDED . workElement)))
);endsetq
(if (/= *oldlay* "0")
(progn
; den zu setzenden Layer holen
(setq ret2 (length layerBlae))
(while (not (zerop ret2))
(setq ret2 (1- ret2))
(setq merk (nth ret2 layerBlae))
(if (= (wcmatch merk "*BEM") T) (setq *name* merk))
)
; Layer vorab einschalten
(todo_Reaktor *name*)
; Layer setzen
(setvar "CLAYER" *name*)
)
);endIF
);endDIM
((wcmatch (car befname) "LINE")
; den aktuellen Layer holen
(setq *oldlay* (getvar "CLAYER"))
(setq DEFUN_SETZ (VLR-ACDB-REACTOR "DEFUN_SETZ"
'((:VLR-OBJECTAPPENDED . workElement)))
);endsetq
);endLINE
((wcmatch (car befname) "ARC")
; den aktuellen Layer holen
(setq *oldlay* (getvar "CLAYER"))
(setq DEFUN_SETZ (VLR-ACDB-REACTOR "DEFUN_SETZ"
'((:VLR-OBJECTAPPENDED . workElement)))
);endsetq
);endLINE
((wcmatch (car befname) "CIRCLE")
; den aktuellen Layer holen
(setq *oldlay* (getvar "CLAYER"))
(setq DEFUN_SETZ (VLR-ACDB-REACTOR "DEFUN_SETZ"
'((:VLR-OBJECTAPPENDED . workElement)))
);endsetq
);endLINE
)
)
#############################################################################################################
(defun workElement (reatyp Data /)
(princ "\n Bearbeite Element...")
(setq z_Set z_koor) ;wert aus Variable holen
(setq lastAcadObjekt (last Data))
(setq lastAcadObjekt (entget lastAcadObjekt))
(cond
((= (cdr (assoc 0 lastAcadObjekt)) "LINE")
(if (/= z_koor 0.0)
(progn
(princ "\n Ändere Z-Höhe Linie...")
(EH_WORK lastAcadObjekt 10 z_Set)
(EH_WORK lastAcadObjekt 11 z_Set)
(setq list_elem (cons lastAcadObjekt list_elem ))
)
)
) ;end Linie
((= (cdr (assoc 0 lastAcadObjekt)) "XLINE")
(if (/= z_koor 0.0)
(progn
(princ "\n Ändere Z-Höhe Hilfslinie...")
(EH_WORK lastAcadObjekt 10 z_Set)
(EH_WORK lastAcadObjekt 11 0.0)
(setq list_elem (cons lastAcadObjekt list_elem ))
)
)
) ;end Hilfslinie
((= (cdr (assoc 0 lastAcadObjekt)) "ARC")
(if (/= z_koor 0.0)
(progn
(princ "\n Ändere Z-Höhe Bogen...")
(EH_WORK lastAcadObjekt 10 z_Set)
(setq list_elem (cons lastAcadObjekt list_elem ))
)
)
) ;end Bogen
((= (cdr (assoc 0 lastAcadObjekt)) "CIRCLE")
(if (/= z_koor 0.0)
(progn
(princ "\n Ändere Z-Höhe Kreis...")
(EH_WORK lastAcadObjekt 10 z_Set)
(setq list_elem (cons lastAcadObjekt list_elem ))
)
)
) ;end Kreis
((= (cdr (assoc 0 lastAcadObjekt)) "MTEXT")
(if (/= z_koor 0.0)
(progn
(princ "\n Ändere Z-Höhe Text...")
(EH_WORK lastAcadObjekt 10 z_Set)
(setq list_elem (cons lastAcadObjekt list_elem ))
)
)
(setq tb (boundingBox lastAcadObjekt 10.0))
(princ "\n Setze 4 Punkte um Text...")
(setq p1 (nth 0 tb))
(setq p2 (nth 1 tb))
(setq p3 (nth 2 tb))
(setq p4 (nth 3 tb))
; Koordinatens. auf welt setzen...
(command "bks" "")
(command "punkt" p1)
(command "punkt" p2)
(command "punkt" p3)
(command "punkt" p4)
) ;end Text
((= (cdr (assoc 0 lastAcadObjekt)) "QLEADER")
(if (/= z_koor 0.0)
(progn
(princ "\n Ändere Z-Höhe Schnellführung-Text...")
(EH_WORK lastAcadObjekt 10 z_Set)
(setq list_elem (cons lastAcadObjekt list_elem ))
)
)
) ;end Schnellführung-Text
((= (cdr (assoc 0 lastAcadObjekt)) "LEADER")
(if (/= z_koor 0.0)
(progn
(princ "\n Ändere Z-Höhe Bezugslinie...")
(EH_WORK lastAcadObjekt 10 z_Set)
(setq list_elem (cons lastAcadObjekt list_elem ))
)
)
) ;end Schraffur
((= (cdr (assoc 0 lastAcadObjekt)) "HATCH")
(if (/= z_koor 0.0)
(progn
(princ "\n Ändere Z-Höhe Text...")
(EH_WORK lastAcadObjekt 10 z_Set)
(EH_WORK lastAcadObjekt 11 z_Set)
(setq list_elem (cons lastAcadObjekt list_elem ))
)
)
) ;end Schraffur
(t nil)
);endcond
);endworkElement
#############################################################################################################
(defun workDimension (reatyp Data /)
;wert aus Variable holen
(setq z_Set z_koor)
(setq merk (last Data))
(setq merk (entget merk))
; Type...
(setq dimtyp (cdr (assoc 0 merk)))
(if (= dimtyp "DIMENSION")
(progn
(setq lastAcadObjekt merk)
(princ "\n Bearbeite Dimension...")
(EH_WORK lastAcadObjekt 10 z_Set)
(EH_WORK lastAcadObjekt 11 z_Set)
(if (/= (cdr (assoc 16 lastAcadObjekt)) nil )
(progn
(EH_WORK lastAcadObjekt 16 z_Set)
)
);endIF
(setq list_elem (cons lastAcadObjekt list_elem ))
);endprogn
);endIF
);endworkDimension
#############################################################################################################
;Initialisierung des Reactors
(defun reaload ()
(princ "\n Aktiviere Callback-Funktion...")
(vl-load-com)
(if (not *DEFUN_TODO*)
(progn
(vlr-command-reactor nil
'((:vlr-CommandWillStart . before))
)
(vlr-command-reactor nil
'((:vlr-commandEnded . after))
)
(vlr-command-reactor nil
'((:vlr-commandCancelled . cancel))
)
(setq *DEFUN_TODO* 'T)
);endprogn
);endif
);endreaload
#############################################################################################################
;*************************************************************************
;
; Konstruktionshöhe aus einem vom Anwender gewählten 3DPunkt auslesen und
; der Variable >z_koor< zuweisen.
; Elemente wie Linien / Bögen usw. werden jetzt in der gesetzten Einfügehöhe
; plaziert.
; --> siehe coe_special_kitschen.lsp Reaktor-Funktionen
;
;*************************************************************************
(defun C:ZHoehe(/ 3D_Point test)
(setvar "cmdecho" 0) ; Deaktiviere die Protokollierung von command...
(setq bks_ZPos (caddr(trans '(0.0 0.0 0.0) 1 0 )))
; wir holen uns die Z-Höhe
(setq 3D_Point (getpoint "\nZ-Höhe für Nachfolgende Eingaben: "))
(setq z_koor (caddr 3D_Point))
(setq z_koor (+ bks_ZPos z_koor))
(command "setvar" "USERS1" z_koor)
;COUNTING ROUTINE
;******************************************************************************************************
(princ "\n Lade Funktion C:ZHoehe... ") ; wir schreiben in die Befehlszeile
(setvar "cmdecho" 1) ; Aktiviere die Protokollierung von command...
);endZHoehe
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP