; ---------------------------------------------------------------------------------------- ; Rundgliederkette ; Copyright by Urs Thali 05.05.2005 ; added: proposals, multi-lang-string by der_Wolfgang@Cad.de xx.08.2007 ; OSD V12.xx and newer (tested up to V15.50) ; fixed: problem with width of name suffix by der_Wolfgang@Cad.de 09.12.2021 ; used in 20.4.1 und Express 8.0 ; ---------------------------------------------------------------------------------------- (in-package :examples) (use-package :oli) (defparameter *chain-measurement-proposals* '(( 8 10 12 14 16) ;; Dicke / thickness ( 24 30 36 42 80) ;; Teilung / pitch ( 27.2 34 40.8 47.6 56) ;; Breite / width )) #| ;; oder in Anlehnung an DIN 5685-G, Form G, gerade (defparameter *chain-measurement-proposals* '(( 3 4 5 6 7 8);; Dicke / thickness ( 26 32 35 42 49 52);; Teilung / pitch ( 12 16 20 24 28 32);; Breite / width )) |# (sd-defdialog 'rundgliederkette :dialog-title (sd-multi-lang-string "Link Chain, rounded" :german "Rundgliederkette") :toolbox-button :force :persistent-proposals t ;; keep user entered value of proposals across osdm session :variables ' ( (V_DICKE :value-type :length :initial-value 16 ; Vorgabewert :proposals (first *chain-measurement-proposals*) :auto-add-proposal t :proposals-order :sorted :title (sd-multi-lang-string "Thickness s" :german "Dicke s") ) (V_TEILUNG :value-type :length :initial-value 80 ; Vorgabewert :proposals (second *chain-measurement-proposals*) :auto-add-proposal t :proposals-order :sorted :title (sd-multi-lang-string "Pitch t" :german "Teilung t") ) (V_BREITE :value-type :length :initial-value 56 ; Vorgabewert :proposals (third *chain-measurement-proposals*) :auto-add-proposal t :proposals-order :sorted :title (sd-multi-lang-string "Width ba" :german "Breite ba") ) (V_STK :value-type :positive-number :initial-value 10 ; Vorgabewert :proposals '(10 20 30 50 80 100) :auto-add-proposal t :proposals-order :sorted :title (sd-multi-lang-string "# links" :german "Anz. Glieder") ) (RICHTUNG_KETTE :value-type :measure-direction :built-in-feedback nil :title (sd-multi-lang-string "Direction" :german "Richtung") :initial-enable t :prompt-text (sd-multi-lang-string "Specify direction of chain to grow." :german "Richtung der Kette angeben.") ) (BOLZENFLAECHE :value-type :face :title (sd-multi-lang-string "Bolt face" :german "Bolzenfläche") :initial-optional t :initial-enable NIL ;; not supported / tut nicht richtig :initial-visible NIL :prompt-text (sd-multi-lang-string "Specify face of location bolt for holding the chain." :german "Zylinderfläche des Aufnahmebolzens angeben.") :after-input (let (elementeigenschaften r_bolzen richtung_bolzen) (setq elementeigenschaften (sd-inq-geo-props BOLZENFLAECHE :dest-space :global)) (setq r_bolzen (sd-cylinder-radius elementeigenschaften)) (setq richtung_bolzen (sd-cylinder-axis-dir elementeigenschaften)) (setq v_versatz r_bolzen) ;(setq richtung_erstes_kettenglied richtung_bolzen) ) :next-variable (unless RICHTUNG_KETTE 'RICHTUNG_KETTE) ) (RICHTUNG_ERSTES_KETTENGLIED :value-type :measure-direction :built-in-feedback nil :title (sd-multi-lang-string "Bolt dir" :german "Bolzenrichtg") :initial-enable t :prompt-text (sd-multi-lang-string "Specify direction of location bolt for 1st link of chain." :german "Richtung des Aufnahmebolzens für erstes Kettenglied (senkrecht zur Kettenrichtung) angeben.") ) (P0_3D :value-type :point-3d :title (sd-multi-lang-string "Start Pnt" :german "Startpunkt") ) (V_VERSATZ :value-type :length :initial-value 0 ; Vorgabewert :title (sd-multi-lang-string "Offset" :german "Versatz") :proposals '(8 10 12 14 16) :auto-add-proposal t :proposals-order :sorted :prompt-text (sd-multi-lang-string "Specify offset for starting point. Normaly radius of location bolt." :german "Versatz zum Startpunktes angeben. Typischerweise Radius des Aufnahmebolzens.") ) (curr-wp :initial-value (sd-inq-curr-wp)) (curr-part :initial-value (sd-inq-curr-part)) ) ;; end variables :ok-action '(kette richtung_kette richtung_erstes_kettenglied v_dicke v_teilung v_breite v_stk P0_3D v_versatz) :cleanup-action '(progn (when curr-wp (sd-call-cmds (current_wp curr-wp))) (when curr-part (sd-call-cmds (current_part curr-part))) ) ) ;; end dialog (defun kette (richtung_kette richtung_erstes_kettenglied v_dicke v_teilung v_breite v_stk P0_3D v_versatz) (let ((P0) (P1) (bgrname) (teilename-rel) (teilename) (teilename.2-rel) (teilename.2) (bgrname-abs) (prefix-c (sd-multi-lang-string "chain" :german "Kette")) (prefix-l (sd-multi-lang-string "link" :german "Kettenglied")) ) (setf P0 (gpnt2d 0 0)) (setf P1 (sd-vec-add P0 (gpnt2d 0 (- (/ v_breite 2) (/ v_dicke 2))))) (setf bgrname (format nil "~A_~A_~A_~A" prefix-c v_dicke v_teilung v_breite)) (when (sd-pathname-to-obj (format nil "/~A" bgrname)) (setf bgrname (sd-gen-obj-basename :assembly :parent "/" :prefix (format nil "~A." bgrname)))) (setf teilename-rel (format nil "~A_~A_~A" prefix-l v_dicke v_teilung )) (setf teilename (format nil "/~A/~A" bgrname teilename-rel)) (setf teilename.2-rel (format nil "~A.2" teilename-rel)) (setf teilename.2 (format nil "/~A/~A" bgrname teilename.2-rel)) (setf bgrname-abs (format nil "/~A" bgrname)) ;; (pprint (list bgrname teilename-rel teilename teilename.2-rel teilename.2 bgrname-kompl bgrname-abs)) (sd-call-cmds (create_workplane :new :owner "/" :pt_dir :origin P0_3D :normal (first richtung_kette) :u_dir (first richtung_erstes_kettenglied) )) (sd-call-cmds (GEOMETRY_MODE :REAL)) ; garantiert Geometrielinien solid (sd-call-cmds (create_assembly :name bgrname :owner "/" )) (sd-call-cmds (circle :center P1 (/ v_dicke 2) )) (sd-call-cmds (turn :part teilename :keep_profile :yes :rotation_angle (sd-deg-to-rad -180) :axis :horiz P0 )) (sd-call-cmds (extrude :distance (/ v_teilung 2) :keep_wp :yes )) (sd-call-cmds (reflect_3d :reflect_plane :neg_v )) (sd-call-cmds (POSITION_WP :workplane :current :par_wp :ref_wp :current :offset (- (/ v_teilung 2) (- (/ v_breite 2) v_dicke) ) )) (sd-call-cmds (reflect_3d :reflect_plane :w )) (when (> v_stk 1) (sd-call-cmds (create_multiple_pa_radial :owner bgrname-abs :source (sd-inq-curr-part) :count 1 :axis :w :angle_increment (sd-deg-to-rad 90) )) ;fixed: problem with width of name suffix (setq teilename.2 (sd-inq-obj-pathname (car (remove (sd-inq-curr-part) (sd-inq-obj-children (sd-pathname-to-obj bgrname-abs)) :test 'equal)))) (sd-call-cmds (position_pa :part_assembly teilename.2 :translate :dir :w :len v_teilung ))) (when (> v_stk 2) (sd-call-cmds (create_multiple_pa_array :owner bgrname-abs :basename teilename-rel :count (- (/ v_stk 2) 1) :direction :w :offset (* v_teilung 2) ))) (when (> v_stk 3) (sd-call-cmds (create_multiple_pa_array :owner bgrname-abs :source teilename.2 :basename teilename-rel :count (- (/ v_stk 2) (if (evenp v_stk) 1 2)) :direction :w :offset (* v_teilung 2) ))) (sd-call-cmds (position_pa :part_assembly bgrname-abs :translate :dir :w :len (- (/ v_breite 2) v_dicke) ; damit ist Berührpunkt = Startpunkt )) (unless (sd-num-equal-p 0 v_versatz) (sd-call-cmds (position_pa :part_assembly bgrname-abs :translate :dir :neg_w :len v_versatz ; weitere Verschiebung ))) (sd-call-cmds (delete_3d :workplane :current )) ) ; Ende let ) #| test: rundgliederkette :richtung_kette :x :p0_3d 20,-60,000 :richtung_erstes_kettenglied :z :v_stk 1 complete rundgliederkette :richtung_kette :x :p0_3d 20,-30,030 :richtung_erstes_kettenglied :z :v_stk 2 complete rundgliederkette :richtung_kette :x :p0_3d 20,000,060 :richtung_erstes_kettenglied :z :v_stk 3 complete rundgliederkette :richtung_kette :x :p0_3d 20,030,090 :richtung_erstes_kettenglied :z :v_stk 4 complete rundgliederkette :richtung_kette :x :p0_3d 20,060,120 :richtung_erstes_kettenglied :z :v_stk 5 complete rundgliederkette :richtung_kette :x :p0_3d 20,090,150 :richtung_erstes_kettenglied :z :v_stk 6 complete |#