Hallo CAD-Gemeinde,
bei Nemetschek gibt es eine tolle Option zum konstruieren.
Mit dem Fadenkreuz auf ein Zeichenelement, z.B. Linie, Wand, Kreis,
Fenster, Text usw. zeigen, Doppelklick mit der linken Maustast,
und schon kann man mit dem gewählten Element und genau den Eigenschaften
dieses Elements weiterzeichnen.
Das geht auch in AutoCad 2009.
In der entsprechenden Menüdatei unter Doppelklickaktionen einen neuen Befehlsnamen definieren.
Dann wie z.B. hier bei Doppelklickaktion Linie folgenden Befehlablauf im neuen Befehlsnamen einfügen.
^C^C(if(not C:bw_setact)(load "eigsetz2"));bw_setact;linie
Folgende Lispdatei hier im Forum gefunden muß in den Supportpfad. Bei mir abgespeichert unter "eigsetz2.lsp".
Wenn ihr einen anderen Namen verwenden wollt, müßt ihr auch im Befehlsablauf den Dateinamen ändern.
;;; Lisp-File created at... DATE : 05.August.2004 / Time : 10:50:28
;;; Source by Rolf "Benwisch" Wischnewski (www.benwisch.de)
;;; ×××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××-
(vl-load-com) ;_ load ActiveX support
;;; Name of main program(s) : (C:BW_SETACT)
;;; List of functions
;;; BW_AC-DOC
;;; BW_ACAD
;;; BW_VLA-OBJ
;;; BW_VLX:GETPROP
;;; ENAME?
;;; ETYPE<
;;; STR?
(defun c:bw_setact (/
obj
vla-obj
sysvarlst
bw_ac-doc
bw_acad
bw_vla-obj
bw_vlx:getprop
ename?
etype<
str?
;;; GLOBALS *SetAct#sysvar*
;;; *setact#sysvardimstyle*
;;; *ACAD-OBJECT*
;;; *ACTIVE-DOC*
)
;;;
;;; ---------------------
;;; ×× LOCAL FUNCTIONS ××
;;; ---------------------
;;;
(defun bw_ac-doc (/)
(cond (*active-doc*)
((quote default)
(setq *active-doc* (vla-get-activedocument (bw_acad)))
)
)
)
;;;×××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××
(defun bw_acad (/)
(cond (*acad-object*)
((quote default)
(setq *acad-object* (vlax-get-acad-object))
)
)
)
;;;×××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××
(defun bw_vla-obj (ename /)
(cond ((= (type ename) (quote ename))
(vlax-ename->vla-object ename)
)
((= (type ename) (quote vla-object)) ename)
)
)
;;;×××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××
(defun bw_vlx:getprop (#vla-obj #proplst /)
(mapcar (function (lambda (p)
(if (vlax-property-available-p #vla-obj p)
(cons p (vlax-get-property #vla-obj p))
(cons p nil)
)
)
)
#proplst
)
)
;;;×××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××
(defun ename? (ent)
(if (= (type ent) (quote ename))
t
)
)
;;;×××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××
(defun etype< (ent)
(if ent
(cdr (assoc 0 (entget ent)))
)
)
;;;×××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××
(defun str? (ent)
(if (= (type ent) (quote str))
t
)
)
;;;×××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××
;;;
;;; -----------------------
;;; ×× END OF FUNCTIONS ××
;;; -----------------------
;;;
;;; < SNIP MAIN >
;;;
(setq sysvarlst (quote ("TEXTSTYLE"
"TEXTSIZE"
"CELWEIGHT"
"CLAYER"
"CECOLOR"
"CELTYPE"
"CELTSCALE"
"HPNAME"
"HPANG"
"HPSCALE"
)
)
)
(if (setq obj (cadr (ssgetfirst)))
(progn (setq obj (list (ssname obj 0))) (sssetfirst))
(progn (initget "Vorher Setze(vonlayer)")
(setq obj
(entsel
"\nFür Eigenschaft Objekt wählen oder [Vorher/Setze(vonlayer)] : "
)
)
)
)
(cond
((str? obj)
(cond ((= "Vorher" obj)
(if *setact#sysvar*
(progn (mapcar (quote setvar) sysvarlst *setact#sysvar*)
(if *setact#sysvardimstyle*
(vla-put-activedimstyle
(bw_ac-doc)
(vla-item (vla-get-dimstyles (bw_ac-doc))
*setact#sysvardimstyle*
)
)
)
)
(princ "\nKein vorheriger Auswahlsatz vorhanden!")
)
)
((= "Setze(vonlayer)" obj)
(foreach sysvar (quote (("celweight" . -1)
("celtscale" . 1.0)
("cecolor" . "bylayer")
("celtype" . "bylayer")
)
)
(vl-catch-all-apply
(quote setvar)
(list (car sysvar) (cdr sysvar))
)
)
)
)
)
((ename? (setq obj (car obj)))
(setq *setact#sysvar* (mapcar (quote getvar) sysvarlst)
*setact#sysvardimstyle* (getvar "DIMSTYLE")
)
(foreach sysvar
(mapcar (quote cons)
sysvarlst
(mapcar (function (lambda (prop)
(if (= "Color" (car prop))
(itoa (cdr prop))
(cdr prop)
)
)
)
(bw_vlx:getprop
(setq vla-obj (bw_vla-obj obj))
(list (if (= "DIMENSION" (etype< obj))
"TextStyle"
"StyleName"
)
(if (= "DIMENSION" (etype< obj))
"TextHeight"
"Height"
)
"Lineweight"
"Layer"
"Color"
"Linetype"
"LinetypeScale"
"PatternName"
"PatternAngle"
"PatternScale"
)
)
)
)
(if (cdr sysvar)
(vl-catch-all-apply
(quote setvar)
(list (car sysvar) (cdr sysvar))
)
)
)
(if (= "DIMENSION" (etype< obj))
(vla-put-activedimstyle
(bw_ac-doc)
(vla-item (vla-get-dimstyles (bw_ac-doc))
(vlax-get-property vla-obj (quote stylename))
)
)
)
)
((quote else) (princ "\n** Programmende **"))
)
(princ)
;;;
;;; < SNIP MAIN >
;;;
)
;;; end of lisp-file
;;;
(princ) ;_ exit quietly
*********************
Bei mir funktioniert diese Routine.
Jetzt meine Frage.
Kann jemand dieses Lisp-Programm um folgenden Punkt erweitern?
Auslesen Multilinienstil und Multilinienmaßstab und diese aktuell setzen.
Gruß
Anita99
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
