;;;--------------------------------------------------------------------;
;;;--------------------------------------------------------------------;
;;; This is the main function for this example.  It loads the ActiveX  ;
;;; dlls, imports the type-libraries from the ADO and CAO dlls, creates;
;;; an ADODB.RecordSet object and a CAO.DbConnect object then it calls ;
;;; the CAOTest dialog.                                                ;
;;;--------------------------------------------------------------------;
(defun rsc_caoInitialize( / lstLT  linkTemplates linkSel thisvalue thisvaluetype 
		    strkeyname thislink slinktemplate field fields fieldsIndex
		    count strWhere strKeyValue lstAllRows dbConnect rs adoconnect)

  ;; Load the ActiveX stuff for Visual LISP
  (vl-load-com)

  ;; Save a reference to the active drawing document.
  (setq acadObj (vlax-get-acad-object)
	acadDoc (vla-get-ActiveDocument acadObj)  ) ; This acadDoc global is used throughout this file.


  (setq gADO-DLLpath     "c:\\program files\\common files\\system\\ado\\msado15.dll")


  (if (null (findfile gADO-DLLpath))
      (progn
	(alert (strcat "Could not load ADO type library from: " gADO-DLLpath)) 
	(exit)
      )
  )
  ;; Import the ADO type library
  ;; Note: We must provide prefixes for these methods and properties because some conflict
  ;; with protected LISP symbols such as APPEND().
  (if (null adok-adStateOpen)            ; Check that ADO type library has not yet been loaded.
      (vlax-import-type-library :tlb-filename gADO-DLLpath
     	  :methods-prefix "adom-"
 	  :properties-prefix "adop-"
 	  :constants-prefix "adok-"
      )
  )


  ;; Import the CAO type library.
  (if (null caom-GetLinkTemplates)           ; Check that CAO type library has not yet been loaded.
      (vlax-import-type-library :tlb-filename "cao16enu.tlb" ; Should be in acad.exe dir.
     	  :methods-prefix "caom-"
 	  :properties-prefix "caop-"
 	  :constants-prefix "caok-"
   ))


  ;; Define a global variable, dbConnect
  (rscInitDbConnect_Click)


  (if rs
      (if (/= adok-adStateClosed (vlax-get-property rs "State"))
	  (vlax-invoke-method rs "CLOSE")))
  (setq rs nil)		; In VBA, setting recordSet to 'Nothing' disconnects. Not needed in LISP?
  (setq rs (vlax-create-object "ADODB.Recordset"))

    ;; The linkType checkboxes
  ;; Default to have them all checked, so set corresponding globals:
  (setq bENTITYLINK    T
	bFSLABEL       nil
	bATTACHEDLABEL nil)

(cond
    ((= rsc_kword "All") (X_rebuildAllSPIDs))
    ((= rsc_kword "Select") (X_rebuildWinSPIDs))
    (t (exit))
  )

)


;;;--------------------------------------------------------------------;
;;; Create the CAO.DbConnect object and display it's Version property  ;
;;;--------------------------------------------------------------------;
(defun rscInitDbConnect_Click()
  (setq dbConnect (vlax-create-object "CAO.DbConnect.16"))

  (if (null dbConnect)			; Then something serious is wrong!
      (progn
	(print "Unable to create CAO.DbConnect Automation server! Exiting...")
	(exit)
      )
    ;;Else,
    (print (strcat "CAO.dbConnect Automation server object is created!"))
  )
)



;;;--------------------------------------------------------------------;
;;; Utility function to return the sum of the CAO constants which will ; 
;;; be used for setting the linktype in the CAO.DbConnect.GetLinks().  ;
;;;--------------------------------------------------------------------;
(defun rsc_getLinkTypes( / linkTypes strLinkTypes )
  (setq linkTypes    0
	strLinkTypes "")

  (if bENTITYLINK 
      (progn 
	(setq linkTypes (+ linkTypes caok-kEntityLinkType))
	(setq strLinkTypes (strcat strLinkTypes " kEntityLinkType "))
      )
  )
  (if bFSLABEL 
      (progn
	(setq linkTypes (+ linkTypes caok-kFSLabelType))
	(setq strLinkTypes (strcat strLinkTypes " kFSLabelType "))
      )
  )
  (if bATTACHEDLABEL
      (progn
	(setq linkTypes (+ linkTypes caok-kAttachedLabelType))
	(setq strLinkTypes (strcat strLinkTypes " kAttachedLabelType "))
      )
  )

  (if (equal "" strLinkTypes)
      (setq strLinkTypes "  No link types specified... so no links will be found!")  )

  (cons linkTypes strLinkTypes)		;Return this value
)



;;;--------------------------------------------------------------------;
;;; Utility function to return the sum of the CAO constants which will ; 
;;; be used for setting the linktype in the CAO.DbConnect.GetLinks().  ;
;;;--------------------------------------------------------------------;
(defun getLinkTypes( / linkTypes strLinkTypes )
  (setq linkTypes    0
	strLinkTypes "")

  (if bENTITYLINK 
      (progn 
	(setq linkTypes (+ linkTypes caok-kEntityLinkType))
	(setq strLinkTypes (strcat strLinkTypes " kEntityLinkType "))
      )
  )
  (if bFSLABEL 
      (progn
	(setq linkTypes (+ linkTypes caok-kFSLabelType))
	(setq strLinkTypes (strcat strLinkTypes " kFSLabelType "))
      )
  )
  (if bATTACHEDLABEL
      (progn
	(setq linkTypes (+ linkTypes caok-kAttachedLabelType))
	(setq strLinkTypes (strcat strLinkTypes " kAttachedLabelType "))
      )
  )

  (if (equal "" strLinkTypes)
      (setq strLinkTypes "  No link types specified... so no links will be found!")  )

  (cons linkTypes strLinkTypes)		;Return this value
)




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun set-CMDDIA ()
  (setq CMDDIA (getvar "CMDDIA"))
  (setvar "CMDDIA" 0)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun restore-CMDDIA ()
  (setvar "CMDDIA" CMDDIA)
)





; MDR - 25mar2000 - changed from .center to .centroid



(defun X_rebuildSPIDs ( / rsc_kword)

  (initget 1 "All Select")
  (setq rsc_kword (getkword "\nRebuild All SPID labels or Select SPID labels: (All / Select)"))
  (cond
    ((= rsc_kword "All") (rsc_caoInitialize))
    ((= rsc_kword "Select") (rsc_caoInitialize))
    (t (exit))
  )
)



(defun X_rebuildAllSPIDs ( / rsc_spid_size cmde omde TextBorder ss1 cntspc cnt ename ss2 lscr lkget 
				si pt text_pnt pt_text ed spid_layer 
	       		 )



  (initget 7)
  (setq rsc_spid_size (getreal "\nEnter SPID Text Size: "))


(defun *error* (msg)
    (setvar "CMDECHO" cmde)
    (setvar "OSMODE" omde)
    (princ (strcat "\Error: " msg))
    (princ)
) ; end fun	       

    (command "undo" "be")

    (setq cmde (getvar "CMDECHO"))
    (setq omde (getvar "OSMODE"))
    (setvar "CMDECHO" 0)
    (setvar "OSMODE" 0)
    (setq TextBorder 0.667)	;This is the size of the border around the SPID

;delete all SPID text
    (if	(setq ss1 (ssget "x" '((0 . "TEXT") (8 . "K_TXT_SPC_*"))))
	(command "erase" ss1 "")
    ) ;end if

;delete all SPID lines
    (if	(setq ss1 (ssget "x" '((0 . "LINE") (8 . "K_TXT_SPC_*"))))
	(command "erase" ss1 "")
    ) ;end if

    ;; MAKE SELECTION SET OF LINKED SPACES

    (if	(not
	    (setq ss1 (ssget "x" '((0 . "LWPOLYLINE") (8 . "LNK_SPC_*"))))
	)
	   (progn
	       (alert
		   "You do not have any spaces\n   cannot continue ... Sorry!"
	       )
	       (exit)
	   )
    ) ;end if

        (setq linkTemplate "SPACE")

  (setq strLinkTypes "")
	;; For linktypes, Specify the sum of constants:
	;;     kEntityLinkType kFSLabelType kAttachedLabelType
	(setq linkTypes     (car (getLinkTypes))
	      strLinkTypes (cdr (getLinkTypes)))
	(setq linkSel (vlax-invoke-method DbConnect "Getlinks" linkTemplate nil linkTypes))

      (if (null linkSel)
      (alert "No links in drawing!"))

  (setq cntspc (sslength ss1))


    (setq cnt 0)

    ;; LOOP THROUGH SPACES

    (setq ename (ssname ss1 cnt))
    (setq ss2 nil)
    (princ "\n-------< Start >-------")
    (while ename
	(princ (strcat "\n-------< Processing "
		       (itoa (1+ cnt))
		       " of "
		       (itoa cntspc)
		       " >-------"
	       )
	)
	(setq ss2 (ssadd ename))
        (setq selectedEname (ssname ss2 0))
  	(setq selectedobj (vlax-ename->vla-object selectedEname))
  	(setq selectedObjID (vlax-get-property selectedObj "ObjectID"))
  	(setq selectedObjHandle (vlax-get-property selectedObj "Handle"))
      
	;; Find the first link in the linkSel collection which is linked to this object
	(vlax-for thisLink linkSel
	  	    (if (equal selectedobjId (vlax-get-property thisLink "ObjectID"))
	  		(setq link thisLink))
	)



    (if (null link)
      (progn 
	(alert  "Unable to retrieve this link")
	(setq lstOutput nil)			; can be used by caotest_dialog
      )
    ;; Else
    (progn

      (setq linkKeyValues (vlax-get-property link "KeyValues"))
      (if (null linkKeyValues)
	  (setq lstOutput  (append lstOutput (list "No key value is defined")))

	(vlax-for OneKeyValue linkKeyValues
		(cond
		  ((equal (vlax-get-property OneKeyValue "FieldName") "SPID")
		   (setq si (vlax-variant-value (vlax-get-property OneKeyValue "Value")))
		   )
		)		  

        );_vlax-for OneKeyValue linkKeyValues
      );_if not null keyValues
    )
  )


      
	(princ "Space Id:")
	(princ si)
	(if si
	    (progn
	        (setq pt (ade_expreval ename ".centroid" "point"))
	    	(setq text_pnt (cdr (assoc 1011 (cdadr (assoc -3 (entget ename '("ADE") ))))))
		(setq pt_text (strcat (strcat (rtos (+ (car pt) (car text_pnt)) 2) ",") (rtos (+ (cadr pt) (cadr text_pnt)) 2))) 
		(command "text" "s" "FDC_SPC" "j" "mc" pt_text "0" si)

		(setq ed (entget (entlast)))
		(setq ed (subst (cons 40 rsc_spid_size) (assoc 40 ed) ed)) 

		(entmod ed)

		(tbox2 (entlast) TextBorder (strcat "SPID_" selectedObjHandle))
	        (setq spid_layer (strcat "K_TXT_SPC_" (substr (cdr (assoc 8 (entget ename))) 9 1)))
	        (command "change" "p" "" "p" "la" spid_layer "co" "BYLAYER" "lt" "BYLAYER" "")
	    )
	) ;end if si       
	(setq cnt (1+ cnt))
	(setq ename (ssname ss1 cnt))
	(setq ss2 nil)

    ) ;end while
    (princ "\n-------< Finished >-------")

    (if	lscr
	(ase_lsfree lscr)
    )
    (setq ss3 nil)
    (setq ss2 nil)
    (setq ss1 nil)


    (setvar "OSMODE" omde)
    (setvar "CMDECHO" cmde)

    (command "undo" "end")


    (princ)
) ; end fun





(defun X_rebuildWinSPIDs ( / rsc_spid_size cmde omde TextBorder ss1 cntspc grpdict cnt ename ss2 lscr lkget 
				si current_group group_member pt text_pnt pt_text ed spid_layer 
	       )

(while 1

  (initget 7)
  (setq rsc_spid_size (getreal "\nEnter SPID Text Size (ESC to Exit): "))


(defun *error* (msg)
    (setvar "CMDECHO" cmde)
    (setvar "OSMODE" omde)
;    (princ (strcat "\Error: " msg))
    (princ)
) ; end fun	       

    (command "undo" "be")

    (setq cmde (getvar "CMDECHO"))
    (setq omde (getvar "OSMODE"))
    (setvar "CMDECHO" 0)
    (setvar "OSMODE" 0)
    (setq TextBorder 0.667)	;This is the size of the border around the SPID

    ;; MAKE SELECTION SET OF LINKED SPACES

    (if	(not
	    (setq ss1 (ssget '((0 . "LWPOLYLINE") (8 . "LNK_SPC_*"))))
	)
	   (progn
	       (alert
		   "You do not have any spaces\n   cannot continue ... Sorry!"
	       )
	       (exit)
	   )
    ) ;end if

         (setq linkTemplate "SPACE")

  (setq strLinkTypes "")
	;; For linktypes, Specify the sum of constants:
	;;     kEntityLinkType kFSLabelType kAttachedLabelType
	(setq linkTypes     (car (getLinkTypes))
	      strLinkTypes (cdr (getLinkTypes)))
	(setq linkSel (vlax-invoke-method DbConnect "Getlinks" linkTemplate nil linkTypes))

      (if (null linkSel)
      (alert "No links in drawing!"))

   (setq cntspc (sslength ss1))



    ;get a list of all groups
    (setq grpdict (dictsearch (namedobjdict) "ACAD_GROUP"))



    (setq cnt 0)

    ;; LOOP THROUGH SPACES

    (setq ename (ssname ss1 cnt))
    (setq ss2 nil)
    (princ "\n-------< Start >-------")
    (while ename
	(princ (strcat "\n-------< Processing "
		       (itoa (1+ cnt))
		       " of "
		       (itoa cntspc)
		       " >-------"
	       )
	)
	(setq ss2 (ssadd ename))


        (setq selectedEname (ssname ss2 0))
  	(setq selectedobj (vlax-ename->vla-object selectedEname))
  	(setq selectedObjID (vlax-get-property selectedObj "ObjectID"))
  	(setq selectedObjHandle (vlax-get-property selectedObj "Handle"))
      
	;; Find the first link in the linkSel collection which is linked to this object
	(vlax-for thisLink linkSel
	  	    (if (equal selectedobjId (vlax-get-property thisLink "ObjectID"))
	  		(setq link thisLink))
	)



    (if (null link)
      (progn 
	(alert  "Unable to retrieve this link")
	(setq lstOutput nil)			; can be used by caotest_dialog
      )
    ;; Else
    (progn

      (setq linkKeyValues (vlax-get-property link "KeyValues"))
      (if (null linkKeyValues)
	  (setq lstOutput  (append lstOutput (list "No key value is defined")))

	(vlax-for OneKeyValue linkKeyValues
		(cond
		  ((equal (vlax-get-property OneKeyValue "FieldName") "SPID")
		   (setq si (vlax-variant-value (vlax-get-property OneKeyValue "Value")))
		   )
		)		  

        );_vlax-for OneKeyValue linkKeyValues
      );_if not null keyValues
    )
  )


	(princ "Space Id:")
	(princ si)
	(if si
	    (progn
	      (setq current_group(reverse (dictsearch (cdar grpdict) si)))
	      (if current_group
		(progn	;Delete the SPID and 4 line border (old style SPID
		  (if (setq group_member  (cdr (assoc 340 current_group))) (entdel group_member))
		  (if (setq group_member  (cdr (assoc 340 (cdr current_group)))) (entdel group_member))
		  (if (setq group_member  (cdr (assoc 340 (cddr current_group)))) (entdel group_member))
		  (if (setq group_member  (cdr (assoc 340 (cdddr current_group)))) (entdel group_member))
		  (if (setq group_member  (cdr (assoc 340 (cddddr current_group)))) (entdel group_member))
		)	  
	      )
	      (setq current_group(reverse (dictsearch (cdar grpdict) (strcat "SPID_" selectedObjHandle))))
	      (if current_group
		(progn	;Delete the SPID and 4 line border New Style SPID
		  (if (setq group_member  (cdr (assoc 340 current_group))) (entdel group_member))
		  (if (setq group_member  (cdr (assoc 340 (cdr current_group)))) (entdel group_member))
		  (if (setq group_member  (cdr (assoc 340 (cddr current_group)))) (entdel group_member))
		  (if (setq group_member  (cdr (assoc 340 (cdddr current_group)))) (entdel group_member))
		  (if (setq group_member  (cdr (assoc 340 (cddddr current_group)))) (entdel group_member))
		)	  
	      )
	      (setq pt (ade_expreval ename ".centroid" "point"))
	      (setq text_pnt (cdr (assoc 1011 (cdadr (assoc -3 (entget ename '("ADE") ))))))
	      (setq pt_text (strcat (strcat (rtos (+ (car pt) (car text_pnt)) 2) ",") (rtos (+ (cadr pt) (cadr text_pnt)) 2))) 
	      (command "text" "s" "FDC_SPC" "j" "mc" pt_text "0" si)

	      (setq ed (entget (entlast)))
	      (setq ed (subst (cons 40 rsc_spid_size) (assoc 40 ed) ed))


	      (entmod ed)

	      (tbox2 (entlast) TextBorder (strcat "SPID_" selectedObjHandle)) ;Side effect of tbox2 is the Previous selection is the text and box

	      (setq spid_layer (strcat "K_TXT_SPC_" (substr (cdr (assoc 8 (entget ename))) 9 1)))
	      (command "change" "p" "" "p" "la" spid_layer "co" "BYLAYER" "lt" "BYLAYER" "")
	    )
	) ;end if si       
	(setq cnt (1+ cnt))
	(setq ename (ssname ss1 cnt))
	(setq ss2 nil)

    ) ;end while
    (princ "\n-------< Finished >-------")

    (if	lscr
	(ase_lsfree lscr)
    )
    (setq ss3 nil)
    (setq ss2 nil)
    (setq ss1 nil)


    (setvar "OSMODE" omde)
    (setvar "CMDECHO" cmde)

    (princ)

(command "undo" "end")

) ;end of while
) ; end fun


(defun TBOX2 (text_to_box border_percent group_name / textent ssgroup border_offset ang sinrot cosrot 
                   t1 t2 p0 p1 p2 p3 p4 )

  (command "-group" "e" group_name)

  (command)

  (setq textent (entget text_to_box))

  (setq ssgroup (ssadd text_to_box))

  (setq border_offset (* (cdr (assoc 40 textent)) border_percent))

  (setq p0 (cdr (assoc 10 textent))
        ang (cdr (assoc 50 textent))
        sinrot (sin ang)
        cosrot (cos ang)
        t1 (car (textbox textent))
        t2 (cadr (textbox textent))
        p1 (list 
          (- (+ (car p0)
                (- (* (car t1) cosrot)(* (cadr t1) sinrot))
	     )
	     border_offset
          )
          (- (+ (cadr p0)
                (+ (* (car t1) sinrot)(* (cadr t1) cosrot))
	     )
	     border_offset
          )
      )
      p2 (list 
        (+ (+ (car p0)
              (- (* (car t2) cosrot)(* (cadr t1) sinrot))
	   )
	   border_offset
        )
        (- (+ (cadr p0)
              (+ (* (car t2) sinrot)(* (cadr t1) cosrot))
	   )
	   border_offset
        )
      )
      p3 (list 
        (+ (+ (car p0)
              (- (* (car t2) cosrot)(* (cadr t2) sinrot))
	   )
	   border_offset
        )
        (+ (+ (cadr p0)
              (+ (* (car t2) sinrot)(* (cadr t2) cosrot))
	   )
	   border_offset
        )
      )

      p4 (list 
        (- (+ (car p0)
              (- (* (car t1) cosrot)(* (cadr t2) sinrot))
	   )
	   border_offset
        )
        (+ (+ (cadr p0)
              (+ (* (car t1) sinrot)(* (cadr t2) cosrot))
	   )
	   border_offset
        )
      )
  )
  (command "line" p1 p2 "")
  (setq ssgroup (ssadd (entlast) ssgroup))
  (command "line" p2 p3 "")
  (setq ssgroup (ssadd (entlast) ssgroup))
  (command "line" p3 p4 "")
  (setq ssgroup (ssadd (entlast) ssgroup))
  (command "line" p1 p4 "")
  (setq ssgroup (ssadd (entlast) ssgroup))

  (command "-group" "c" group_name "" ssgroup "")
  (princ)

)

(X_rebuildSPIDs)
(princ)