;;; ========================================================================
;;; Autor:  Wolfgang Eberharter, Westcam Datentechnik GmbH
;;; Datum: 14 01 2004
;;;
;;; In einem Skript soll der Befehl AMCVTFRAME12 verwendet werden. Dieser Befehl
;;; erfordert allerdings eine Benutzereingabe, die nicht per Lisp oder Skript
;;; durchgeführt werden kann.
;;; Hier werden die entsprechenden Funktionen von AutoDesk übernommen und
;;; an der Stelle der Eingabeaufforderung so modifiziert, dass sie für unsere
;;; Zwecke brauchbar sind.
;;; ========================================================================*/



;;;**************************************************************************************;;;

;;;Hier folgen die modifizierten AutoDesk-Funktionen

;;;======================================================================================
;;; AMCVTFRAME12
;;;======================================================================================
(defun c:wec_amcvtframe12 (wec_blockname / )


  (gensv)
  (genlade "gen" "genzvi" wec_genzvi12to13)
  (setq ok (wec_genzvi12to13 nil))
  (if ok
    (genprompt (genmsg "genbas" 315))
  )
  (genun)
  genretdum

)


(defun wec_genzvi12to13( asli / title border scale next entli ent enb unchg
 ss ssobj obj pins ll ru dum result anzra anztit boxt boxb )

  (gen1sv)
  (setq border (gencdrlese "BORDER" asli)
    title (gencdrlese "TITLE" asli)
    scale (gencdrlese "SCALE" asli)
    anzra 0
    anztit 0
    next 0
  )
  (if (and border title)
    (progn
      ; scan for given blocks
      (setq ss
        (genssget
          (list
            (list "STR" "_X")
            (list "FILTER"
              (list
                (cons -4 "<and")
                (cons 0 "INSERT")
                (cons -4 "<or")
                (cons 2 border)
                (cons 2 title)
                (cons -4 "or>")
                (cons -4 "and>")
              )
            )
          ) ; list
        ) ; genssget
      ) ; setq
      (if (and ss (/= 0 (setq dum (sslength ss))))
        (while (< next dum)
          (setq entli (genentget (ssname ss next)))
;;;Hummel: Inserted strcase here
;;;Eckardt: removed strcase for V15
;          (if (= (cdr (assoc 2 entli)) (strcase title))
          (if (= (cdr (assoc 2 entli)) title)
            (setq ent (cdr (assoc -1 entli))
              anztit (+ 1 anztit)
            )
          )
;;;Hummel: Inserted strcase here
;;;Eckardt: removed strcase for V15
;          (if (= (cdr (assoc 2 entli)) (strcase border))
          (if (= (cdr (assoc 2 entli)) border)
            (setq enb (cdr (assoc -1 entli))
              anzra (+ 1 anzra)
            )
          )
          (setq next (1+ next))
        ) ; while
      ) ; if
    ) ; progn
  ) ; if border and title
  (if (or (not title) (not border)
          (and title border ent enb (or (> anzra 1) (> anztit 1))))
    (progn
      (if (or (> anzra 1) (= 0 anzra ))
        (setq enb wec_blockname ; Modifizierung durch Westcam!

;;;	       (car
;;;          (gensel
;;;            (list
;;;              (list "PROMPT" (genmsg "genzvo" 14))
;;;              (list "FLAG" "e")
;;;              (list "EMPTY" 2)
;;;              (list "OBJ1" '("INSERT"))
;;;            )
;;;          )) ; gensel
	      ;Modifizierung Ende


        ) ; steq
      ) ; if

      (if (or (> anztit 1) (= 0 anztit))
        (setq ent wec_blockname ; Modifizierung durch Westcam!

;;;	       (car
;;;          (gensel
;;;            (list
;;;              (list "PROMPT" (genmsg "genzvo" 15))
;;;              (list "FLAG" "e")
;;;              (list "EMPTY" 2)
;;;              (list "OBJ1" '("INSERT"))
;;;            )
;;;          )) ; gensel
	       ; Modifizierung Ende


        ) ; setq
      ) ; if
    ) ; progn
  )
  (if (and ent enb)
    (progn
      (setq boxb (genentbox (genbasoli "ELE" enb "TRANS" 1))
         boxt (genentbox (genbasoli "ELE" ent "TRANS" 1))
      )
      (if (and (car boxb) (car boxt))
        (progn
          ; check whether title block is located in border area
          (setq boxb (nth 1 boxb) boxt (nth 1 boxt))
          (if (or (< (caar boxt) (caar boxb))
                  (< (cadar boxt) (cadar boxb))
                  (> (caadr boxt) (caadr boxb))
                  (> (cadadr boxt) (cadadr boxb)))
            (progn
              (genprompt (genmsg "genzvo" 16))
              (if (not (genyesno (genmsg "genzvo" 17) nil))
                (setq enb nil ent nil)
              ) ; if gennein
            ) ; progn
          ) ; if in box
        ) ; progn
      ) ; if good results from genentbox
    ) ; progn
  ) ; if ent and entb

  ; now creating title border block/object
  (if (and ent enb)
    (progn
;;;Krimmer 28.01.00: This function is now registered in C...
;      (genlade "gen" "genpm" genpmscunru)
      (setq ssobj (genssadd ent))
      (genssadd ssobj enb)
;;;Hummel: scale can also be given.
      (if
        (if scale
;;;if given scale does not match
          (/= (genpmscreal scale)
            (cdr (assoc 41 (genentget enb)))
          );/=
          T
        )
;;;in cases of prompts always take insertion facor of blocks
;;;(probably more save)
        (setq
          scale (cdr (assoc 41 (genentget enb)))
          scale (cadr (genpmscunru scale))

	  ;; Änderung Westcam: Keine Abfrage mehr auf den Maßstab. Es wird immer der vorgeschlagene Maßstab verwendet,
	  ;; ohne dem Benutzer eine Eingabemöglichkeit zu geben.
;;;          scale
;;;          (geninloc
;;;            (LIST
;;;              (LIST "PR" (strcat "\n" (genmsg "gentitle" 101)))
;;;              (LIST "ST" scale)
;;;              (list "D" scale)
;;;            )
;;;          );geninloc


	);setq
      );if
      (setq
        border (cdr (assoc 2 (genentget enb)))
        title (cdr (assoc 2 (genentget ent)))
        pins (cdr (assoc 10 (genentget enb)))
        unchg (list "GEN-TITLE-SCA" "GEN-TITLE-SIZ")
        xdata
        (genbasoli
          "SCALE" scale
          "BORDER" border
          "TITLE"  title
          "UNCHG" unchg
        ) ; genbasoli
        obj
        (genobjcollect
          (list
            (list "SS" ssobj)
            (list "REACTOR" nil)
            (list "SORT" (list "TIT"))
            (list "OWNER" "GEN")
            (list "XAPPL" "GENTITLE")
            (list "XVER" "13")
            (list "XART" T)
            (list "XDATA" xdata)
          )
        ) ; genobjcollect
      ) ; setq
      (genobjedit
        (list
          (list "OBJ" obj)
          (list "XAPPL" "GENTITLE")
          (list "XVER"  "13")
          (list "XFLAG" 2)
          (list "XART" T)
          (list "XDATA"
            (list
              (list "HRA" enb)
              (list "HTIT" ent)
              (list "GENIUSID" obj)
            )
          )
        )
      ) ; genobjedit
      (setq scale (genpmscreal scale)
        ll (genal-entipkt enb "LL" scale nil)
        ru (genal-entipkt enb "RU" scale nil)
      )
      (if ll
        (setq ll (list (+ (car ll) (car pins)) (+ (cadr ll) (cadr pins))))
        (setq ll (car boxb))
      )
      (if ru
        (setq ru (list (+ (car ru) (car pins)) (+ (cadr ru) (cadr pins))))
        (setq ru (cadr boxb))
      )
;Krimmer 28.01.00: genpmscset was moved to gencvt.lsp
      (genlade "gen" "gencvt" genpmscset)
      (genpmscset
        (list
          (list "ENAME" enb)
          (list "PLOTFACTOR" scale)
          (list "CORNERS" ll ru)
          (list "LIMITS" 0)
          (list "VIEWS" 0)
          (list "BASIC" nil)
        ) ;; list
      )
      (setq dum (gentitgetdata obj)
        dum (gencdrlese "XDATA" dum)
        result
        (genzviinquire (list (list "GENIUSID" (gencdrlese "GENIUSID" dum))))
      )

    ) ; progn
  )
  (gen1un)
  result
)