(defun main 

  (vl-ACAD-defun C:PT_ID)
  (vl-ACAD-defun C:PT_ID_UPDATE)
  (vl-ACAD-defun C:PT_ID_SETUP)

  (PT_ID_INFO )

  (defun GETSTRINGD (STRING  DEFAULT  INGET)
    (setq STR (STRCAT STRING " <" DEFAULT ">: "))

    (if (/= INGET "") 
	(INITGET INGET)
      (setq ANSW (GETSTRING STR)))
    
    (if (= ANSW "") 
	(setq ANSW DEFAULT))

    ANSW)
      

  (defun GETKWORDD (STRING  DEFAULT  INGET)
    (setq STR (STRCAT STRING " [" INGET "] <" DEFAULT ">: "))

    (if (/= INGET "") 
	(INITGET INGET)
      (setq ANSW (GETKWORD STR)))
    
    (if (= ANSW "") 
	(setq ANSW DEFAULT))

    ANSW)


  (defun GETDISTD (STRING  DEFAULT  INGET)
    (setq STR (STRCAT STRING " <" (RTOS DEFAULT) ">: "))

    (if (/= INGET "") 
	(INITGET INGET)
      (setq ANSW (GETDIST STR)))
    
    (if (= ANSW "") 
	(setq ANSW DEFAULT))

    ANSW)


  (defun C:PT_ID
    (_al-bind-alist '(ATT1 ATT2 ID:XVALUE ID:YVALUE ENT))
    (setq PT (GETPOINT "\n	Taskas: "))
    (ads-cmd ".-insert")
    (ads-cmd ID:MARK)
    (ads-cmd PT)
    (ads-cmd ID:SCALE)
    (ads-cmd ID:SCALE)
    (ads-cmd "")
    (PT_ID:ATTMOD (ENTLAST )))

  (defun C:PT_ID_UPDATE
    (_al-bind-alist '(ENT))
    (setq ENT (ENTGET (CAR (ENTSEL "\n	Pasirinkite bloka: "))))
    (PT_ID:ATTMOD (CDR (ASSOC -1 ENT))))

  (defun PT_ID:ATTMOD
    (BLOCK)
    (setq ENT BLOCK)
    (setq ATT1 (ENTNEXT ENT))
    (setq ATT2 (ENTNEXT ATT1))
    (setq ATT1 (ENTGET ATT1))
    (setq ATT2 (ENTGET ATT2))
    (setq PT (CDR (ASSOC 10 (ENTGET ENT))))
    (setq PT (TRANS PT 0 1))
    (setq ID:XVALUE (STRCAT "X= " (RTOS (* ID:LSCALE (CADR PT)))))
    (setq ID:YVALUE (STRCAT "Y= " (RTOS (* ID:LSCALE (CAR PT)))))
    (setq ATT1 (SUBST (CONS 1 ID:XVALUE) (ASSOC 1 ATT1) ATT1))
    (ENTMOD ATT1)
    (setq ATT1 (SUBST (CONS 1 ID:YVALUE) (ASSOC 1 ATT1) ATT1))
    (ENTMOD ATT1)
    (setq ATT2 (SUBST (CONS 1 ID:XVALUE) (ASSOC 1 ATT2) ATT2))
    (ENTMOD ATT2)
    (setq ATT2 (SUBST (CONS 1 ID:YVALUE) (ASSOC 1 ATT2) ATT2)))


  (defun PT_ID:SETUP
    (_al-bind-alist '(ID:UNITS ID:SCALETOPO ID:SCALEDWG))
    (setq ID:LSCALE 0.01)
    (setq ID:SCALE 10.0)
    (setq ID:MARK "PT_id")
    (setq ID:SCALETOPO "M")
    (setq ID:SCALEDWG "M")
    (setq ID:UNITS (LIST Then OR Else (cons "CM" 10) (cons "DM" 100) (cons "M" 1000) (cons "KM" 10000)))
    (setq ID:MARK (GETSTRINGD "Tasko simbolio blokas" ID:MARK 0))
    (setq ID:SCALETOPO (GETKWORDD "Topopagrindo vienetai" ID:SCALETOPO "Km M Dm Cm MM"))
    (setq ID:SCALEDWG (GETKWORDD "Brezinio vienetai" ID:SCALEDWG "Km M Dm Cm MM"))
    (setq ID:SCALETOPO (CDR (ASSOC (STRCASE ID:SCALETOPO) ID:UNITS)))
    (setq ID:SCALEDWG (CDR (ASSOC (STRCASE ID:SCALEDWG) ID:UNITS)))
    (setq ID:SCALE (/ ID:SCALEDWG ID:SCALETOPO))
    (setq ID:LSCALE (/ ID:SCALEDWG ID:SCALETOPO))
    (setq ID:SCALE (GETDISTD "Tasko bloko mastelis" ID:SCALE 0))
    (setq ID:LSCALE (GETDISTD "Vienetu mastelis" ID:LSCALE 0))
    (setq ID:MARK (STRCAT ID:MARK ".dwg"))
    (setq ID:MARK (FINDFILE ID:MARK)))


  (defun C:PT_ID_SETUP
    (defun PT_ID_INFO
      (_al-bind-alist '(STR LIC LOGIN))
      (setq LOGIN (GETVAR "LOGINNAME"))
      (setq STR (STRCAT "\n	 Tai va, " LOGIN "  : \n"))
      (setq STR Then OR Else)
      (setq STR (STRCAT STR " *** ----------------------------------------------------------------------\n"))
      (setq STR (STRCAT STR "	 Programa uzrso topopagrindo koordinaciu reiksmes i bloko, kuris nurodytas \n"))
      (setq STR (STRCAT STR " kaip tasko simbolis, atributa. Tikslumas kontroliuojamas \n"))
      (setq STR (STRCAT STR " AutoCAD'o kintamuoju LUPREC - 'Line Units PRECision'\n\n"))
      (setq STR (STRCAT STR " PT_ID \n"))
      (setq STR (STRCAT STR "    iterpia bloka ir iraso jo iterpimo tasko koordinate i atributus;\n\n"))
      (setq STR (STRCAT STR " PT_ID_UPDATE  \n"))
      (setq STR (STRCAT STR "    pakeicia bloko atributu reiksmes pagal aktyvia koordinaciu sistema;\n"))
      (setq STR (STRCAT STR " ---***--------------------------------------------------------------------\n"))
      (setq LIC "\n	 Galite naudoti sia programa savo reikmems ir ja platinti kitiems tol,\n")
      (setq LIC (STRCAT LIC " kol ji islieka tokia, kokia ja gavote.\n\n"))
      (setq LIC (STRCAT LIC " As negaliu uzdrausti jums nagrineti sia programa ar aiskintis jos \n"))
      (setq LIC (STRCAT LIC " veikimo principus. Bet, kadangi Jus jau sutikote su  Autodesk Inc. \n"))
      (setq LIC (STRCAT LIC " licenzijos salygomis, tokie veiksmai priestarauja firmos Autodesk Inc. \n"))
      (setq LIC (STRCAT LIC " licenzijais. As jus perspejau                                           ;)\n\n"))
      (setq LIC (STRCAT LIC " ------***-----------------------------------------------------------------\n"))
      (setq LIC (STRCAT LIC "                                     Remkites laisva programine iranga \n"))
      (setq LIC (STRCAT LIC " \n"))
      (setq LIC (STRCAT LIC "                        Klausimai? Pageidavimai? ejs@seniejitrakai.net \n"))
      (setq LIC (STRCAT LIC "                                                     (c) 1997-2011 ejs\n"))
      (setq LIC (STRCAT LIC " ---------***--------------------------------------------------------------\n"))
      (TEXTSCR )
      (PRINC STR)
      (PRINC LIC))))