(in-package :custom) (use-package :oli) (sd-defdialog 'am-txt-search :dialog-title (sd-multi-lang-string "Search text" :german "Text suche") :toolbox-button :force :variables '( (search-string :title (sd-multi-lang-string "Text" :german "Text") :value-type :string :proposals ("a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" ) :max-proposals 20 :after-input (progn (search-init search-string hit-list balloon-frame case-sensitive highlight-color) (highlight-txt hit-list :next zoom-factor)) :initial-value "a") (preselected-text :selection *sd-anno-text-seltype* :after-input (sd-set-variable-status 'search-string :value (format nil "~{~a~}" (if (sd-3daccess-version-p) (my-am-inq-text-strings preselected-text) (sd-am-inq-text-strings preselected-text)))) :toggle-type :invisible) (balloon-frame :title (sd-multi-lang-string "Balloon frame" :german "Nur Text mit Ballon") :value-type :boolean :toggle-type :wide-toggle :initial-value t ; :persistent-data-storage t ) (parameters :title (sd-multi-lang-string "Parameter" :german "Einstellungen") :expand-shrink (case-sensitive highlight-color color-reset zoom-factor)) (case-sensitive :title (sd-multi-lang-string "Case sensitive" :german "Groß-und Kleinschr. beachten") :value-type :boolean :toggle-type :wide-toggle :initial-value nil ; :persistent-data-storage t ) (highlight-color :title (sd-multi-lang-string "Highlight color" :german "Highlight Farbe") :value-type :rgb-color :initial-value 16711680 ; :persistent-data-storage t ) (color-reset :value-type :boolean :toggle-type :wide-toggle :title (sd-multi-lang-string "Reset color" :german "Farbe zurücksetzen") :prompt-text (sd-multi-lang-string "Reset color" :german "Farbe zurücksetzen") :initial-value t) (zoom-factor :title (sd-multi-lang-string "Zoom" :german "Zoom") :value-type :scale :minimum 1 :maximum 100 :initial-value 25 ; :persistent-data-storage t ) ("-") (hits :title (sd-multi-lang-string "Hits found" :german "Gef. Treffer") :value-type :display-only) (prev-text :title "<<<" :push-action (highlight-txt hit-list :prev zoom-factor) :toggle-type :grouped-toggle :initial-enable nil) (next-text :title ">>>" :push-action (highlight-txt hit-list :next zoom-factor) :toggle-type :grouped-toggle :initial-enable nil) (hit-list :value-type :list :toggle-type :invisible) ("-") (search-button :title (sd-multi-lang-string "search" :german "Suchen") :toggle-type :wide-toggle :push-action (progn (search-init search-string hit-list balloon-frame case-sensitive highlight-color) (highlight-txt hit-list :next zoom-factor))) ("-") (delete-search-results :title (sd-multi-lang-string "delete result" :german "Ergebnisse löschen") :push-action (delete-results hit-list) :toggle-type :wide-toggle :initial-enable nil :initial-visible (not (sd-3daccess-version-p)))) :ok-action '(reset-all-text-colors hit-list) :cancel-action '(reset-all-text-colors hit-list) :local-functions '( (search-init (search-string hit-list balloon-frame case-sensitive highlight-color) (reset-all-text-colors hit-list) (let ((all-matching-texts (search-for-string-in-anno search-string balloon-frame case-sensitive highlight-color))) (if all-matching-texts (progn (sd-set-variable-status 'hit-list :value all-matching-texts) (sd-set-variable-status 'hits :value (length all-matching-texts)) (sd-set-variable-status 'prev-text :enable t) (sd-set-variable-status 'next-text :enable t) (sd-set-variable-status 'delete-search-results :enable t)) (reset-results)))) (search-for-string-in-anno (search-string balloon-frame case-sensitive highlight-color) (when search-string (let ( (all-matching-txt-strings (list)) (all-texts (sd-call-cmds (get_selection :focus_type *sd-anno-text-seltype* :select :docu_text :by_drawing_docu_rest)))) (dolist (txt all-texts) (dolist (txt-line (if (sd-3daccess-version-p) (my-am-inq-text-strings txt) (sd-am-inq-text-strings txt))) (let ( (txt-line-cc (if case-sensitive txt-line (string-downcase txt-line))) (search-string-cc (if case-sensitive search-string (string-downcase search-string)))) (when (sd-string-match-pattern-p search-string-cc txt-line-cc) (let* ( (txt-attributes (if (sd-3daccess-version-p) (my-am-inq-text-attributes txt) (sd-am-inq-text-attributes txt))) (frame-type (if (sd-3daccess-version-p) (my-am-text-attributes-struct-frame txt-attributes) (sd-am-text-attributes-struct-frame txt-attributes))) (txt-color (if (sd-3daccess-version-p) (sd-rgb-to-color (my-am-text-attributes-struct-color txt-attributes)) (sd-rgb-to-color (sd-am-text-attributes-struct-color txt-attributes))))) (when (or (null balloon-frame) (and balloon-frame (equal frame-type :balloon))) (if (sd-3daccess-version-p) (my-am-change-text-color :text txt :color (sd-color-to-rgb highlight-color)) (sd-call-cmds (am_text_modify :sel_list txt :color highlight-color))) (push (list txt txt-color) all-matching-txt-strings))))))) all-matching-txt-strings))) (highlight-txt (hit-list direction zoom-factor) (when hit-list (let* ( (item (first (first hit-list))) (zoom-scale 3) (zoom-out-value-pos (* zoom-factor zoom-scale)) (zoom-out-value-neg (* zoom-factor zoom-scale)) (zoom-pos-start (sd-get-annotator-position :object item)) (zoom-pos-start-list (sd-string-split zoom-pos-start ",")) (zoom-start-org-x (read-from-string (first zoom-pos-start-list))) (zoom-start-x (- zoom-start-org-x zoom-out-value-neg)) (zoom-end-x (+ zoom-start-org-x zoom-out-value-pos)) (zoom-start-org-y (read-from-string (second zoom-pos-start-list))) (zoom-start-y (- zoom-start-org-y zoom-out-value-neg)) (zoom-end-y (+ zoom-start-org-y zoom-out-value-pos))) (if item (progn (sd-put-buffer (format nil "docu_generic_window_vp ~a,~a ~a,~a" zoom-start-x zoom-start-y zoom-end-x zoom-end-y)) (if (equal direction :prev) (sd-set-variable-status 'hit-list :value (left-rotate hit-list)) (sd-set-variable-status 'hit-list :value (right-rotate hit-list)))) (sd-set-variable-status 'hit-list :value (rest hit-list)))))) (reset-all-text-colors (hit-list) (when color-reset (dolist (icl hit-list) (let ( (txt (first icl)) (txt-color (second icl))) (if (sd-3daccess-version-p) (my-am-change-text-color :text txt :color (sd-color-to-rgb highlight-color)) (sd-call-cmds (am_text_modify :sel_list txt :color highlight-color))))))) (delete-results (hit-list) (dolist (result hit-list) (sd-call-cmds (am_delete (first result)))) (reset-results)) (reset-results () (sd-set-variable-status 'hit-list :value (list)) (sd-set-variable-status 'hits :value 0) (sd-set-variable-status 'prev-text :enable nil) (sd-set-variable-status 'next-text :enable nil) (sd-set-variable-status 'delete-search-results :enable nil)) (left-rotate (list) (append (rest list) (list (first list)))) (right-rotate (list) (append (last list) (butlast list))))) (defun sd-3daccess-version-p () (if (sd-string-match-pattern-p "*ACCESS*" (string-upcase (sd-inq-version-string))) t nil)) (defun my-am-inq-text-strings (txt) (first (first (sd-execute-annotator-function :fnc (format nil "DOCU_INQ_TEXT GLOBAL POINTER '~a' " (sd-get-annotator-reference :object txt)))))) (defun create-and-load-me10-macro (macro-s &optional file) (let ( (file (if file file (format nil "~a/me10-anno-temp-macro.m" (sd-inq-temp-dir))))) (when (stringp macro-s) (setq macro-s (list macro-s))) (if (listp macro-s) (with-open-file (write-stream file :direction :output :if-exists :supersede :if-does-not-exist :create) (dolist (macro-line macro-s) (format write-stream "~a~%" macro-line))) (sd-display-message "Failed to create macro.")) (sd-execute-annotator-command :cmd (format nil "INPUT '~a'" file)))) (create-and-load-me10-macro (list "DEFINE inq_text_struct " "PARAMETER txt_item " "LOCAL Tok " "INQ_SELECTED_ELEM GLOBAL POINTER txt_item " "LET Tok ( DOCU_OPEN_CONNECTION_TO_SD ) " "LET Tok ( DOCU_ADD_LINE_TO_SD ( '(list ' + ( STR ( INQ 6 ) ) + ' ' + ( STR ( INQ 5 ) ) + ' ' + ( STR ( INQ 7 ) ) + ' ' + ( STR ( INQ 4 ) ) + ' ' + ( STR ( INQ 8 ) ) + ' ' + ( STR ( INQ 3 ) ) + ' ' + ':' + ( STR ( INQ 602 ) ) + ' ' + ':' + ( STR ( INQ 601 ) ) + ' ' + ( DOCU_CSTRING_TO_LSTRING ( INQ 302 ) ) + ' ' + ( DOCU_CSTRING_TO_LSTRING ( INQ 303 ) ) ) )" "LET Tok ( DOCU_ADD_LINE_TO_SD ( '(list ' + ( STR ( X_OF INQ 201 ) ) + ' ' + ( STR ( Y_OF INQ 201 ) ) + ' ' + ( STR ( Z_OF INQ 201 ) ) + ' ' + '))' ) )" "LET Tok ( DOCU_CLOSE_CONNECTION_TO_SD ) " "END_DEFINE ")) (defstruct my-am-text-attributes-struct (size (read-from-string (nth 0 me10-result)) :type long-float) (ratio (read-from-string (nth 1 me10-result)) :type long-float) (slant (read-from-string (nth 2 me10-result)) :type long-float) (linesp (read-from-string (nth 3 me10-result)) :type long-float) (angle (read-from-string (nth 4 me10-result)) :type long-float) (adjust (read-from-string (nth 5 me10-result)) :type symbol) (fill (read-from-string (nth 6 me10-result)) :type symbol) (frame (read-from-string (nth 7 me10-result)) :type symbol) (font1b (nth 8 me10-result) :type string) (font2b (nth 9 me10-result) :type string) (color (make-gpnt3d :x (first (nth 10 me10-result)) :y (second (nth 10 me10-result)) :z (third (nth 10 me10-result))) :type gpnt3d)) (defun my-am-inq-text-attributes (txt) (let* ( (me10-result (sd-execute-annotator-function :fnc (format nil "inq_text_struct '~a'" (sd-get-annotator-reference :object txt)))) (struct (make-my-am-text-attributes-struct :size (nth 0 me10-result) :ratio (nth 1 me10-result) :slant (nth 2 me10-result) :linesp (nth 3 me10-result) :angle (nth 4 me10-result) :adjust (nth 5 me10-result) :fill (nth 6 me10-result) :frame (nth 7 me10-result) :font1b (nth 8 me10-result) :font2b (nth 9 me10-result) :color (make-gpnt3d :x (first (nth 10 me10-result)) :y (second (nth 10 me10-result)) :z (third (nth 10 me10-result)))))) struct)) (defun my-am-change-text-color (&key text color) (sd-execute-annotator-command :cmd (format nil "CHANGE_COLOR RGB_COLOR ~a GLOBAL POINTER '~a' CONFIRM " color (sd-get-annotator-reference :object text))))