(in-package :custom)
(use-package :oli)




(sd-defdialog 'am-rectangle-centerline
	:dialog-title "Rectangle center line"
	:toolbox-button :force
	:variables '(
  (rec-lines 
   :selection (*sd-anno-line-seltype*)
   :multiple-items t
   :title "Rectangle"
   :prompt-text "Select the four lines forming a rectangle."
   :after-input (if (= (length rec-lines) 4)
                 (let (
                  (adl (list))
                  (vec-res (list)) 
                  (scl (get-item-scale (first rec-lines))))
                 
                  (unless scl
                   (sd-display-message "Failed to inquire scale.")
                   (sd-put-buffer "cancel"))

                  (dolist (i rec-lines)
                   (let* (
                    (geo-props (sd-am-inq-specific-geo-props i))
                    (spnt (sd-vec-scale (sd-am-line-struct-start-pnt geo-props) (/ 1 scl)))
                    (epnt (sd-vec-scale (sd-am-line-struct-end-pnt geo-props) (/ 1 scl)))
                    (dir-vec (sd-vec-normalize (sd-vec-subtract spnt epnt))))  
                     (push (list dir-vec spnt epnt i) vec-res)))

                  (dolist (l1 vec-res)
                   (dolist (l2 vec-res)
                    (unless (equal l1 l2)
                     (let* (
                      (l1-item (fourth l1))
                      (l2-item (fourth l2))
                      (v1 (first l1))
                      (v2 (first l2))
                      (syml-s (calc-rec-smy-line-coord-strng l1))
                      (syml-e (calc-rec-smy-line-coord-strng l2))
                      (owner (sd-get-annotator-reference :object l1-item))
                      (cmd-strng (format nil "ag_create_sym_line ~a ~a '~a'" syml-s syml-e owner)))
                       
                       (when (sd-vec-colinear-p v1 v2)
                        (unless (or (member l1 adl) (member l2 adl))
                        
                         ;; ;BUG in am_create_symline tested in version 18.0-F000
                         ;; ;Maybe someone want to report to PTC?
                         ;; (sd-call-cmds 
                          ;; (am_create_symline l1-item l2-item))

                         (sd-execute-annotator-command :cmd cmd-strng)
                         (push l1 adl)
                         (push l2 adl))))))))
                 (sd-display-message "Please select the four line forming a rectangle.")))))



(defun calc-rec-smy-line-coord-strng (l-lst)
 (let* (
  (spnt-1 (second l-lst))
  (epnt-1 (third l-lst))
  (spnt1-x (gpnt2d_x spnt-1))
  (spnt1-y (gpnt2d_y spnt-1))
  (epnt1-x (gpnt2d_x epnt-1))
  (epnt1-y (gpnt2d_y epnt-1))                     
  (slsp-x (/ (+ spnt1-x epnt1-x) 2))
  (slsp-y (/ (+ spnt1-y epnt1-y) 2)))
   (format nil "~a,~a" slsp-x slsp-y)))



(defun get-item-scale (item)
 (let* (
  (lname (sd-am-inq-unique-name item))
  (cmd-strng-scl (format nil "Docu_get_am_owner_of_upn '~a'" lname))
  (ret-val (sd-execute-annotator-function :fnc cmd-strng-scl)))
  
   (when ret-val
    (getf ret-val :scale))))



(sd-execute-annotator-command :cmd "INPUT 'C:/Temp/foo1.m'")

(sd-execute-annotator-command :cmd 
 "DEFINE ag_create_sym_line
   PARAMETER Pnt1
   PARAMETER Pnt2
   PARAMETER Edge_pointer
   
   LOCAL Curr_part
   LOCAL Owner
   
   INQ_SELECTED_ELEM GLOBAL POINTER Edge_pointer
   LET Owner (INQ 309)
   
   INQ_PART CURRENT
   LET Curr_part (INQ 302)
   EDIT_PART Owner
   SYMLINE Pnt1 Pnt2
   EDIT_PART Curr_part
  END_DEFINE")
  
(unless (string>= (getf (sd-inq-version) :major) "16")
 (sd-execute-annotator-command :cmd 
  "DEFINE Docu_get_am_owner_of_upn
    PARAMETER Upn
    LOCAL Owner_type
    LOCAL Look_upn
    IF (DOCU_PART_EXISTS Upn)
      LET Owner_type ''
      LET Look_upn Upn
      WHILE (Owner_type = '')
        IF (DOCU_PART_HAS_INFO Look_upn'DOCU_VIEW')
          LET Owner_type \":VIEW\"
        ELSE_IF (DOCU_PART_HAS_INFO Look_upn 'DOCU_SKETCH')
          LET Owner_type \":SKETCH\"
        ELSE_IF ((DOCU_PART_HAS_INFO Look_upn 'DOCU_FRAME') AND (DOCU_IS_SHEET (DOCU_PARENT_PART_ID Look_upn)))
          LET Owner_type \":FRAME\"
        ELSE_IF (DOCU_PART_HAS_INFO Look_upn 'DOCU_SHEET')
          LET Owner_type \":SHEET\"
        END_IF
        IF (Owner_type = '')
          LET Look_upn (DOCU_PARENT_PART_ID Look_upn)
          IF (Look_upn = '')
            LET Owner_type \":invalid\"
            LET Look_upn Upn
          END_IF
        END_IF  
      END_WHILE
      INQ_PART Look_upn
      LET Dmy (DOCU_OPEN_CONNECTION_TO_SD)
      LET Dmy (DOCU_ADD_LINE_TO_SD (\"'(:owner-type \" + Owner_type + ' :pid ' ))
      LET Dmy (DOCU_ADD_LINE_TO_SD CSTRING_TO_LSTRING ESCAPE_SPECIAL_CHARS Look_upn)
      LET Dmy (DOCU_ADD_LINE_TO_SD \" :name \" )
      LET Dmy (DOCU_ADD_LINE_TO_SD CSTRING_TO_LSTRING ESCAPE_SPECIAL_CHARS (INQ 301))
      LET Dmy (DOCU_ADD_LINE_TO_SD \" :scale \" )
      LET Dmy (DOCU_ADD_LINE_TO_SD (STR (INQ 4)))
      IF (DOCU_PART_HAS_INFO Upn'SD_FROM_3D')
        INQ_PART Upn
        LET Dmy (DOCU_ADD_LINE_TO_SD \" :elem-3d-part-name \" )
        LET Dmy (DOCU_ADD_LINE_TO_SD CSTRING_TO_LSTRING ESCAPE_SPECIAL_CHARS (INQ 301))
      END_IF
      LET Dmy (DOCU_ADD_LINE_TO_SD \" )\" )
     LET Dmy (DOCU_CLOSE_CONNECTION_TO_SD)
   ELSE
     LET Dmy (DOCU_WRITE_LINE_TO_SD 'NIL')
   END_IF
 END_DEFINE"))