;;----------------------------------------------------------------------------- ;; for CoCreate OneSpace Designer ;; Description: ;; Teilkreise bemassen ;; ;;----------------------------------------------------------------------------- ;; ;; Filename : teilkreisgeo_15.lsp ;; Version : 1.0 ;; Datum : April 2005/Juni 2007 ;; Author : RainerH@forum@cad.de ;; Download : osd.cad.de ;; SD-Version : adapted to 15.00 ;; ;;----------------------------------------------------------------------------- ;; translated: german/english by der_Wolfgang@forum@Cad.de 15Jul2009 ;; with thanks to tom_kirkman@forum@cocreateusers.org ;;----------------------------------------------------------------------------- (in-package :examples) (use-package :oli) ;;----------------------------------------------------------------------------------------------* ;; Vorgaben setzen: ;; Moeglicher Vorgabewerte: ;; coloring and linetypes ;;----------------------------------------------------------------------------------------------* (setq mlinie_merker "Bohrung") ;; "Bohrung" , "Mittelpunkt" (setq ml_aendern_merker t) ;; t , nil (setq Geofarbe 1,0,0) ;; 1,1,1 ==> RGB-Wert je nach gew. Farbe (setq Geolinientyp :DOT_CENTER) ;; :SOLID :DOTTED :DASHED :LONG_DASHED :DOT_CENTER ;; :DASH_CENTER :CENTER_DASH_DASH :PHANTOM (setq Mlfarbe 0,1,1) ;; 1,1,1 ==> RGB-Wert je nach gew. Farbe (setq Mllinientyp :PHANTOM) ;; :SOLID :DOTTED :DASHED :LONG_DASHED :DOT_CENTER ;; :DASH_CENTER :CENTER_DASH_DASH :PHANTOM ;;----------------------------------------------------------------------------------------------* (sd-defdialog 'am-teilkreisgeo :dialog-title '(sd-multi-lang-string "Radial Centerlines" :german "Teilkreisgeo") :toolbox-button t :mutual-exclusion '(mlinie_b mlinie_m) :variables '( (Geofarbe_aktuell :initial-value (sd-am-geo-attributes-struct-color (sd-am-inq-curr-geometry-attributes))) (Geolinientyp_aktuell :initial-value (sd-am-geo-attributes-struct-linetype (sd-am-inq-curr-geometry-attributes))) (Ml_abs_offset :initial-value (sd-am-center-line-settings-struct-abs-offset (sd-am-inq-curr-center-line-settings))) (Ml_rel_offset :initial-value (sd-am-center-line-settings-struct-rel-offset (sd-am-inq-curr-center-line-settings))) (Besitzer :selection *sd-anno-view-seltype* :select-attribute :docu-calc-geo-only :title (sd-multi-lang-string "Owner" :german "Besitzer") :prompt-text (sd-multi-lang-string "Specify view for Radial Centerlines." :german "Ansicht fuer Teilkreisgeo angeben.") :after-input (progn (setf Massstab_ansicht (sd-am-view-struct-scale (sd-am-inq-view Besitzer))) (setf Massstab_zeichnung (oli::sd-am-inq-drawing-scale)) (setf Massstab_blatt (oli::sd-am-sheet-struct-scale (oli::sd-am-inq-sheet (oli::sd-am-inq-curr-sheet)))) (setf Massstab_blatt (float (read-from-string Massstab_blatt))) ) ) (ruler-cl-pnts :title (sd-multi-lang-string "Define Hole Pattern" :german "Initialisierungspunkte")) (Mittelpunkt :value-type :docupntcnp :selection (*sd-anno-geo-seltype* *sd-anno-center-line-seltype* *sd-anno-symmetry-line-seltype*) :multiple-items nil :title (sd-multi-lang-string "Center Point" :german "Mittelpunkt") :prompt-text (sd-multi-lang-string "Select center point of radial pattern." :german "Mittelpunkt fuer Teilkreisgeo angeben.") :initial-value nil :after-input (progn (setf Mittelpunkt (make-gpnt2d :x (oli::gpntdocu_x Mittelpunkt) :y (oli::gpntdocu_y Mittelpunkt))) (setf Mittelpunkt (sd-vec-scale Mittelpunkt (/ 1 Massstab_ansicht))) ) ) (Bohrungen :selection (*sd-anno-circle-seltype* *sd-anno-arc-seltype* *sd-anno-c-circle-seltype*) :multiple-items t :show-select-menu t :incremental-selection t :title (sd-multi-lang-string "Hole(s)" :german "Bohrung(en)") :prompt-text (sd-multi-lang-string "Select radial hole(s)." :german "Bohrungen fuer Teilkreisgeo angeben.") ) (ruler-cl-exist :title (sd-multi-lang-string "Existing Centerlines" :german "Autom. erstellte Mittellinien")) (ml_aendern :value-type :boolean :title (sd-multi-lang-string "Make Invisible" :german "In Unsichtbare Ìndern") :toggle-type :wide-toggle :initial-value (if ml_aendern_merker t nil) :after-input (if ml_aendern (setf ml_aendern_merker t) (setf ml_aendern_merker nil) ) ) (ruler-cl-create :title (sd-multi-lang-string "Radial CL Length" :german "Teilkreisgeo erstellen")) (mlinie_b :value-type :boolean :title (sd-multi-lang-string "Only at holes" :german "Nur bei Bohrung selbst") :toggle-type :wide-toggle :initial-value (if (equal mlinie_merker "Bohrung") t nil) :after-input (setf mlinie_merker "Bohrung") ) (mlinie_m :value-type :boolean :title (sd-multi-lang-string "Extend To Center Point" :german "Mittelpunkt bis Bohrung") :toggle-type :wide-toggle :initial-value (if (equal mlinie_merker "Mittelpunkt") t nil) :after-input (setf mlinie_merker "Mittelpunkt") ) ) :local-functions '((set-geo-color-ltype (farbe linientyp) (if (string>= (getf (oli::sd-inq-version) :major) "15") (sd-call-cmds (let ((style-curr (sd-get-setting-value "Annotation/Geometry/Standard"))) (MODIFY_DEFAULT_SETTING :path "Annotation/General/LineStyle/Color" :parent_style style-curr :A_COLOR (oli::sd-rgb-to-color farbe)) (MODIFY_DEFAULT_SETTING :path "Annotation/General/LineStyle/Ltype" :parent_style style-curr :A_RANGE linientyp) ) ) (sd-call-cmds (progn (am_geo_color :rgb farbe :done) (am_geo_ltype linientyp :done) )) )) (ok_ausfuehren () (let (Einzelbohrung Zentrum Radius ueberstand winkel anfangspunkt endpunkt Rechteckpunkt_1 Rechteckpunkt_2) (progn ;; Geoemetrieeinstellungen setzen (set-geo-color-ltype Geofarbe Geolinientyp) ;; Alle Bohrungen in der Liste abarbeiten (dolist (Einzelbohrung Bohrungen) (let ((bohrung-geo-props (sd-am-inq-specific-geo-props Einzelbohrung))) ;; Werte fuer Boegen auslesen (when (sd-am-arc-struct-p bohrung-geo-props) (setf Zentrum (sd-am-arc-struct-center bohrung-geo-props)) (setf Radius (sd-am-arc-struct-radius bohrung-geo-props)) ) ;; Werte fuer Geo-Kreise auslesen (when (sd-am-circle-struct-p bohrung-geo-props) (setf Zentrum (sd-am-circle-struct-center bohrung-geo-props)) (setf Radius (sd-am-circle-struct-radius bohrung-geo-props)) ) ;; Werte fuer Hilfsgeo-Kreise auslesen (when (sd-am-constr-circle-struct-p bohrung-geo-props) (setf Zentrum (sd-am-constr-circle-struct-center bohrung-geo-props)) (setf Radius (sd-am-constr-circle-struct-radius bohrung-geo-props)) ) (setf Zentrum (sd-vec-scale Zentrum (/ 1 Massstab_ansicht))) (setf Radius (/ Radius Massstab_ansicht)) ;; Haelfte des Mittellinienueberstandes fuer die Bohrung berechnen (setf ueberstand (+ (+ Radius Ml_abs_offset) (* Radius Ml_rel_offset) ) ) ;; Teilkreisgeo erstellen fuer Auswahl-Option: "Nur bei Bohrung selbst" (when mlinie_b (progn ;; Halbe Linie erstellen vom Zentrum Richtung zu Mittelpunkt (sd-am-create-geo-straight :angle (list Zentrum ;; Startpunkt Mittelpunkt ;; Richtungspunkt ueberstand ;; Laenge ) :owner_type :2dview :owner Besitzer ) ;; Halbe Linie erstellen vom Zentrum Richtung weg vom Mittelpunkt (sd-am-create-geo-straight :angle (list Zentrum ;; Startpunkt Mittelpunkt ;; Richtungspunkt (- ueberstand) ;; Laenge ) :owner_type :2dview :owner Besitzer ) ) ) ;; Teilkreisgeo erstellen fuer Auswahl-Option: "Mittelpunkt bis Bohrung" (when mlinie_m (progn ;; Laenge vom Mittelpunkt zum Zentrumspunkt der Bohrung berechnen (setf laenge (sd-vec-subtract Zentrum Mittelpunkt)) (setf laenge (sd-vec-length laenge)) ;; Linie erstellen (sd-am-create-geo-straight :angle (list Mittelpunkt ;; Startpunkt Zentrum ;; Richtungspunkt (+ laenge ueberstand) ;; Laenge ) :owner_type :2dview :owner Besitzer ) ) ) ;; Mittellinie aendern fuer Auswahl-Option: "In Unsichtbare aendern" ;; Wenn diese nur geloescht wird, dann werden diese wieder neu erstellt, sobald eine ;; Aenderung am 3D-Modell stattfindet oder auch eine erzw. Aktualisierung durchgef. wird ! (when ml_aendern (progn (setf Rechteckpunkt_1 (sd-vec-subtract Zentrum (make-gpnt2d :x (* ueberstand 1.11) :y (* ueberstand 1.11)))) (setf Rechteckpunkt_2 (sd-vec-add Zentrum (make-gpnt2d :x (* ueberstand 1.11) :y (* ueberstand 1.11)))) (setf Rechteckpunkt_1 (sd-vec-scale Rechteckpunkt_1 Massstab_ansicht)) (setf Rechteckpunkt_2 (sd-vec-scale Rechteckpunkt_2 Massstab_ansicht)) (sd-call-cmds (AM_AUX_GEO_MODIFY_SETTING :AUX_SELECT ;;:docu_center_line :by_box_docu_geo (oli::gpntdocu (gpnt2d_x Rechteckpunkt_1) (gpnt2d_y Rechteckpunkt_1) "Annotation") (oli::gpntdocu (gpnt2d_x Rechteckpunkt_2) (gpnt2d_y Rechteckpunkt_2) "Annotation") :color :rgb Mlfarbe :done :line_type Mllinientyp ) :failure () ;; -> Ohne Meldung weiter, wenn keine Mittellinie im Auswahlrechteck vorhanden ist ) ) ) ) ) ;; Teilkreis erstellen mittels gewaehltem Mittelpunkt und dem Zentrumspunkt der zuletzt ;; ermittelten Bohrung aus der Liste (sd-am-create-geo-circular :radius (list Mittelpunkt Zentrum ) :owner_type :2dview :owner Besitzer ) ;; Aktuelle Geoemtrieeinstellungen wieder herstellen (set-geo-color-ltype Geofarbe_aktuell Geolinientyp_aktuell) ;; Erstellten Teilkreis sofort bemassen (sd-put-buffer (format nil "am_create_dim_diamtr :pick1 ~a :prefix ~s" (sd-vec-scale Zentrum (* 1 Massstab_ansicht)) "" ) ) ) ) ) ) :ok-action '(ok_ausfuehren) :cancel-action '() :exception '(set-geo-color-ltype Geofarbe_aktuell Geolinientyp_aktuell) :help-action '(sd-display-url "http://osd.cad.de/lisp_2d.htm#14") )