AutoLISP AutoCAD kts. Trần Ngọc Thắng TỰ BIÊN SOẠN + SƯU TẦM

TranNgocThang76 · Đăng lúc 12/5/2025 18:11:47

<a href="https://www.mediafire.com/file/czicu7v2hdd904k/Library_2008_TnT_For_AutoCAD.zip/file">Library 2008 TnT For AutoCAD</a><a href="https://www.mediafire.com/file/czicu7v2hdd904k/Library_2008_TnT_For_AutoCAD.zip/file">5 o+ D5 M, P9 A4 h0 W

Sao chép mã

********************************************************************************
*          ACADLISP FOR AUTOCAD R.14 -> AUTOCAD R.2012                   *
*       Tran Ngoc Thang DHXD-HaNoi41 from years 1999 -> 2015                *
*                      Suu tam & Soan                                     *
********************************************************************************

; Next available MSG number is  104
; MODULE_ID ACAD2000doc_LSP_
;;; ACAD2000DOC.LSP Version 1.0 for AutoCAD 2000
;;;
;;; Copyright (C) 1994 - 1999 by Autodesk, Inc.
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and
;;; that both that copyright notice and the limited warranty and
;;; restricted rights notice below appear in all supporting
;;; documentation.
;;;
;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;; UNINTERRUPTED OR ERROR FREE.
;;;
;;; Use, duplication, or disclosure by the U.S. Government is subject to
;;; restrictions set forth in FAR 52.227-19 (Commercial Computer
;;; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;; (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;.
;;;
;;; Note:
;;;          This file is loaded automatically by AutoCAD every time
;;;          a drawing is opened.  It establishes an autoloader and
;;;          other utility functions.
;;;
;;; Globalization Note:
;;;          We do not support autoloading applications by the native
;;;          language command call (e.g. with the leading underscore
;;;          mechanism.)

;;;===== Raster Image Support for Clipboard Paste Special =====
;;
;; IMAGEFILE
;;
;; Allow the IMAGE command to accept an image file name without
;; presenting the file dialog, even if filedia is on.
;; Example: (imagefile "c:/images/house.bmp")
;;
(defun imagefile (filename / filedia-save cmdecho-save)
  (setq filedia-save (getvar "FILEDIA"))
  (setq cmdecho-save (getvar "CMDECHO"))
  (setvar "FILEDIA" 0)
  (setvar "CMDECHO" 0)
  (command "_.-image" "_attach" filename)
  (setvar "FILEDIA" filedia-save)
  (setvar "CMDECHO" cmdecho-save)
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Next available MSG number is 11
; MODULE_ID DDVPOINT_LSP_
;;;
;;; ddvpoint.lsp
;;;
;;; Copyright 1992,1994,1996-1998 by Autodesk, Inc.
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and
;;; that both that copyright notice and the limited warranty and
;;; restricted rights notice below appear in all supporting
;;; documentation.
;;;
;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;; UNINTERRUPTED OR ERROR FREE.
;;;
;;; Use, duplication, or disclosure by the U.S. Government is subject to
;;; restrictions set forth in FAR 52.227-19 (Commercial Computer
;;; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;; (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;.
;;; C

DVPOINT - 3D Viewpoint presets dialog.
;;;
;;;             Uses DDVPOINT.DCL for the dialog definition.
;;;             The slide image is in ACAD.SLB.
;;;
;;; ===================== load-time error checking ============================
;;;

  (defun ai_abort (app msg)
   (defun *error* (s)
      (if old_error (setq *error* old_error))
      (princ)
   )
   (if msg
   (alert (strcat " Application error: "
                  app
                  " \n\n  "
                  msg
                  "  \n"
            )
   )
   )
   (exit)
  )

;;; Check to see if AI_UTILS is loaded, If not, try to find it,
;;; and then try to load it.
;;;
;;; If it can't be found or it can't be loaded, then abort the
;;; loading of this file immediately, preserving the (autoload)
;;; stub function.

  (cond
   (  (and ai_dcl (listp ai_dcl)))       ; it's already loaded.

   (  (not (findfile "ai_utils.lsp"))                   ; find it
      (ai_abort "DDVPOINT"
               (strcat "Can't locate file AI_UTILS.LSP."
                        "\n Check support directory.")))

   (  (eq "failed" (load "ai_utils" "failed"))          ; load it
      (ai_abort "DDVPOINT" "Can't load file AI_UTILS.LSP"))
  )

  (if (not (ai_acadapp))             ; defined in AI_UTILS.LSP
   (ai_abort "DDVPOINT" nil)       ; a Nil <msg> supresses
  )                                  ; ai_abort's alert box dialog.

;;; ==================== end load-time operations ===========================

(defun ai_ddvp_start ( / image_x image_y image_h slide_x slide_y slide_h program)
  ;; Get program name
  (if (not (setq program (getvar "program")))
   (setq program "acad")
  )
  (start_image "ddvp_image")
  (slide_image
0 0
(- (setq image_x (dimx_tile "ddvp_image")) 1)
(- (setq image_y (dimy_tile "ddvp_image")) 1)
(strcat program "(ddvp3d)")
  )
  (end_image)
  (setq
      image_x (float image_x)
      image_y (float image_y)
      slide_x 12.4265
      slide_y 9.0
      image_h (/ image_x image_y)
      slide_h (/ slide_x slide_y)
  )
  (if (< slide_h image_h)
(setq slide_y image_y
      slide_x (* slide_y slide_h)
)
(setq slide_x image_x
      slide_y2 (* slide_y (/ image_x 12.4625))
      image_y2 (/ image_y slide_y2)
      slide_y (* slide_y2 image_y2)

)
  )
  (setq ai_ddvp_bx (fix (* 0.295 slide_x))
      ai_ddvp_ax (fix (* 0.65 slide_x))
      ai_ddvp_by (fix (* 0.4875 slide_y))
  )
)

(defun ai_rtd (arg)
  (/ (* arg 180.0) pi)
)

(defun ai_dtr (arg)
  (* pi (/ arg 180.0))
)

(defun ai_ang3dv (v1 v2)
  (if (not (equal v1 v2 1e-12))
(ai_arccos
   (/ (ai_dotp v1 v2)
      (* (sqrt (ai_dotp v1 v1))
         (sqrt (ai_dotp v2 v2))
      )
   )
)
(eval '0.0)
  )
)

(defun ai_arccos (ang)
  (if (not (equal ang 1.0 1e-06))
(if (not (equal ang -1.0 1e-06))
   (atan (sqrt (- 1.0 (expt ang 2.0))) ang)
   (eval pi)
)
(eval '0.0)
  )
)

(defun ai_dotp (v1 v2)
  (+
(* (car v1) (car v2))
(* (cadr v1) (cadr v2))
(* (caddr v1) (caddr v2))
  )
)

(defun ai_ddvp_do ()
  (if (or (>= ai_ddvp_b_curr 360.0)
      (< ai_ddvp_b_curr 0.0)
      (null ai_ddvp_b_curr)
   )
(progn
   (ai_ddvp_drx ai_ddvp_b_last ai_ddvp_bx 0)
   (ai_ddvp_drx ai_ddvp_b_base ai_ddvp_bx 1)
   (mode_tile "ddvp_val_x" 2)
   (set_tile "error" "Invalid angle from X axis.")
)
(if (or (> ai_ddvp_a_curr 90.0)
         (< ai_ddvp_a_curr -90.0)
         (null ai_ddvp_a_curr)
      )
   (progn
      (ai_ddvp_drx ai_ddvp_a_last ai_ddvp_ax 0)
      (ai_ddvp_drx ai_ddvp_a_base ai_ddvp_ax 1)
      (mode_tile "ddvp_val_xyp" 2)
      (set_tile "error" "Invalid angle from XY plane.")
   )
   (done_dialog 1)
)
  )
)

(defun ai_ddvp_set_a (ang)
  (setq ai_ddvp_a_curr ang)
  (if (or (> ang 90.0)
      (< ang -90.0)
      (null ang)
   )
(progn
   (ai_ddvp_drx ai_ddvp_a_last ai_ddvp_ax 0)
   (ai_ddvp_drx ai_ddvp_a_base ai_ddvp_ax 1)
   (set_tile "error" "Invalid angle from XY plane.")
)
(progn
   (set_tile "error" "")
   (ai_ddvp_drx ai_ddvp_a_last ai_ddvp_ax 0)
   (setq ai_ddvp_a_last ai_ddvp_a_curr ai_ddvp_t T)
   (set_tile "ddvp_val_xyp" (rtos ai_ddvp_a_curr 2 1))
   (ai_ddvp_drx ai_ddvp_a_base ai_ddvp_ax 1)
   (ai_ddvp_drx ai_ddvp_a_curr ai_ddvp_ax 7)
)
  )
)

(defun ai_ddvp_set_b (ang)
  (setq ai_ddvp_b_curr ang)
  (if (or (>= ang 360.0)
      (< ang 0.0)
      (null ang)
   )
(progn
   (ai_ddvp_drx ai_ddvp_b_last ai_ddvp_bx 0)
   (ai_ddvp_drx ai_ddvp_b_base ai_ddvp_bx 1)
   (set_tile "error" "Invalid angle from X axis.")
)
(progn
   (set_tile "error" "")
   (ai_ddvp_drx ai_ddvp_b_last ai_ddvp_bx 0)
   (if (= ang 360.0)
      (setq ai_ddvp_b_curr 0.0
            ai_ddvp_a_curr 90.0
            ai_ddvp_p T
            ai_ddvp_b_last ai_ddvp_b_curr
      )
      (setq ai_ddvp_b_last ai_ddvp_b_curr ai_ddvp_t T)
   )
   (set_tile "ddvp_val_x" (rtos ai_ddvp_b_curr 2 1))
   (ai_ddvp_drx ai_ddvp_b_base ai_ddvp_bx 1)
   (ai_ddvp_drx ai_ddvp_b_curr ai_ddvp_bx 7)
)
  )
)

(defun ai_ddvp_drx (ang x1 col / a x2 y2)
  (setq a (polar (list 0.0 0.0)
               (- (* 2.0 pi) (ai_dtr ang))
               25.0
      )
      x2 (+ x1 (fix (car a)))
      y2 (+ ai_ddvp_by (fix (cadr a)))
  )
  (start_image "ddvp_image")
  (vector_image x1 ai_ddvp_by x2 y2 col)
  (end_image)
)

(defun ai_ddvp_image (x y / ang1 ang2 list_xy list_axby list_bxby)
  (setq list_xy (list x y)
      list_axby (list ai_ddvp_ax ai_ddvp_by)
      list_bxby (list ai_ddvp_bx ai_ddvp_by)
  )
  (if (> x (- ai_ddvp_ax 1))
(progn
   (setq ang1 (ai_rtd (- (* 2.0 pi) (angle list_xy list_axby))))
   (if (< 90.0 ang1)
      (setq ang1 (- ang1 180.0))
   )
   (if (< (distance list_xy list_axby) 40)
      (ai_ddvp_set_a ang1)
      (if (< (distance list_xy list_axby) 84)
      (cond ((= ang1 0.0)
               (ai_ddvp_set_a 0.0)
            )
            ((< ang1 -72.0)
               (ai_ddvp_set_a -90.0)
            )
            ((< ang1 -53.0)
               (ai_ddvp_set_a -60.0)
            )
            ((< ang1 -38.0)
               (ai_ddvp_set_a -45.0)
            )
            ((< ang1 -20.0)
               (ai_ddvp_set_a -30.0)
            )
            ((< ang1 -6.0)
               (ai_ddvp_set_a -10.0)
            )
            ((< ang1 6.0)
               (ai_ddvp_set_a 0.0)
            )
            ((< ang1 20.0)
               (ai_ddvp_set_a 10.0)
            )
            ((< ang1 38.0)
               (ai_ddvp_set_a 30.0)
            )
            ((< ang1 53.0)
               (ai_ddvp_set_a 45.0)
            )
            ((< ang1 72.0)
               (ai_ddvp_set_a 60.0)
            )
            (T
               (ai_ddvp_set_a 90.0)
            )
      )
      )
   )
)
(progn
   (setq ang2 (ai_rtd (+ pi (- (* 2.0 pi) (angle list_xy list_bxby)))))
   (if (< 360.0 ang2)
      (setq ang2 (- ang2 360.0))
   )
   (if (< (distance list_xy list_bxby) 40)
      (ai_ddvp_set_b ang2)
      (cond ((= ang2 0.0)
            (ai_ddvp_set_b 0.0)
            )
            ((< ang2 22.5)
            (ai_ddvp_set_b 0.0)
            )
            ((< ang2 67.5)
            (ai_ddvp_set_b 45.0)
            )
            ((< ang2 112.5)
            (ai_ddvp_set_b 90.0)
            )
            ((< ang2 157.5)
            (ai_ddvp_set_b 135.0)
            )
            ((< ang2 202.5)
            (ai_ddvp_set_b 180.0)
            )
            ((< ang2 247.5)
            (ai_ddvp_set_b 225.0)
            )
            ((< ang2 292.5)
            (ai_ddvp_set_b 270.0)
            )
            ((< ang2 337.5)
            (ai_ddvp_set_b 315.0)
            )
            ((< ang2 360.0)
            (ai_ddvp_set_b 0.0)
            )
            (T
            (ai_ddvp_set_b 270.0)
            )
      )
   )
)
  )
)

(defun ai_ddvp_plan ()
  (ai_ddvp_set_a 90.0)
  (ai_ddvp_set_b 270.0)
)

(defun ai_ddvp_setvdir (a b)
  (list (* (sin (ai_dtr (- 90.0 a))) (cos (ai_dtr b)))
      (* (sin (ai_dtr (- 90.0 a))) (sin (ai_dtr b)))
      (cos (ai_dtr (- 90.0 a)))
  )
)

(defun ai_ddvp_set_abs ()
  (setq ai_ddvp_wv 1)
  (ai_ddvp_drx ai_ddvp_b_curr ai_ddvp_bx 0)
  (ai_ddvp_drx ai_ddvp_a_curr ai_ddvp_ax 0)
  (ai_ddvp_drx ai_ddvp_b_base ai_ddvp_bx 0)
  (ai_ddvp_drx ai_ddvp_a_base ai_ddvp_ax 0)
  (setq ai_ddvp_vdir_base (ai_ddvp_fixzero ai_ddvp_vdir_base))
  (ai_ddvp_setang (trans ai_ddvp_vdir_base 1 0 T))
  (setq ai_ddvp_a_base ai_ddvp_a
      ai_ddvp_b_base ai_ddvp_b
  )

  (setq ai_ddvp_vdir_curr
      (ai_ddvp_fixzero
      (trans (ai_ddvp_setvdir ai_ddvp_a_curr ai_ddvp_b_curr) 1 0 T)
      )
  )
  (ai_ddvp_setang ai_ddvp_vdir_curr)
  (setq ai_ddvp_a_curr ai_ddvp_a
      ai_ddvp_b_curr ai_ddvp_b
  )

  (ai_ddvp_set_a ai_ddvp_a_curr)
  (ai_ddvp_set_b ai_ddvp_b_curr)
)

(defun ai_ddvp_set_rel ()
  (setq ai_ddvp_wv 0)
  (ai_ddvp_drx ai_ddvp_b_curr ai_ddvp_bx 0)
  (ai_ddvp_drx ai_ddvp_a_curr ai_ddvp_ax 0)
  (ai_ddvp_drx ai_ddvp_b_base ai_ddvp_bx 0)
  (ai_ddvp_drx ai_ddvp_a_base ai_ddvp_ax 0)
  (setq ai_ddvp_vdir_base (ai_ddvp_fixzero ai_ddvp_vdir_base))
  (ai_ddvp_setang ai_ddvp_vdir_base)
  (setq ai_ddvp_a_base ai_ddvp_a
      ai_ddvp_b_base ai_ddvp_b
  )
  (setq ai_ddvp_vdir_curr
      (ai_ddvp_fixzero
      (trans (ai_ddvp_setvdir ai_ddvp_a_curr ai_ddvp_b_curr) 0 1 T)
      )
  )
  (if ai_ddvp_init
(setq ai_ddvp_vdir_curr (ai_ddvp_fixzero (trans ai_ddvp_vdir_curr 1 0 T))
      ai_ddvp_init nil
)
  )
  (ai_ddvp_setang ai_ddvp_vdir_curr)
  (setq ai_ddvp_a_curr ai_ddvp_a
      ai_ddvp_b_curr ai_ddvp_b
  )
  (ai_ddvp_set_a ai_ddvp_a_curr)
  (ai_ddvp_set_b ai_ddvp_b_curr)
)

(defun ai_ddvp_fixzero (vector / vector_x vector_y vector_z)
  (setq vector_x (car vector)
      vector_y (cadr vector)
      vector_z (caddr vector)
  )
  (if (equal vector_x 0.0 1e-06)
(setq vector_x 0.0)
  )
  (if (equal vector_y 0.0 1e-06)
(setq vector_y 0.0)
  )
  (if (equal vector_z 0.0 1e-06)
(setq vector_z 0.0)
  )
  (list vector_x vector_y vector_z)
)

(defun ai_ddvp_setang (viewdir / viewdir_x viewdir_y viewdir_z ai_viewdir)
  (setq ai_viewdir (ai_ddvp_fixzero viewdir)
      ai_ddvp_b (ai_rtd (angle ai_viewdir '(0.0 0.0)))
  )
  (if (equal (list (car ai_viewdir) (cadr ai_viewdir)) '(0.0 0.0) 1e-06)
(setq ai_ddvp_a 90.0)
(setq ai_ddvp_a (ai_rtd (ai_ang3dv
                           ai_viewdir
                           (list (car ai_viewdir) (cadr ai_viewdir) 0.0)
                        )
                  )
)
  )
  (if (< (caddr ai_viewdir) 0.0)
(setq ai_ddvp_a (- 0.0 ai_ddvp_a))
(setq ai_ddvp_a (abs ai_ddvp_a))
  )
  (if (>= ai_ddvp_b 180.0)
(setq ai_ddvp_b (- ai_ddvp_b 180.0))
(setq ai_ddvp_b (+ ai_ddvp_b 180.0))
  )
  (if (or (= ai_ddvp_a 90.0) (= ai_ddvp_a -90.0))
(setq ai_ddvp_b 270.0)
  )
)

(defun ai_ddvp_main ()
  (ai_ddvp_start)
  (ai_ddvp_setang ai_ddvp_vdir_base)
  (setq ai_ddvp_a_base ai_ddvp_a
      ai_ddvp_b_base ai_ddvp_b
      ai_ddvp_vdir_curr (ai_ddvp_fixzero
                        (ai_ddvp_setvdir ai_ddvp_a_base ai_ddvp_b_base)
                        )
  )
  (ai_ddvp_setang ai_ddvp_vdir_curr)
  (setq ai_ddvp_a_curr ai_ddvp_a
      ai_ddvp_a_last ai_ddvp_a_curr
      ai_ddvp_b_curr ai_ddvp_b
      ai_ddvp_b_last ai_ddvp_b_curr
  )
  (if (= 0 ai_ddvp_wv)
(progn
   (ai_ddvp_set_rel)
   (set_tile "ddvp_rel_ucs" "1")
)
(ai_ddvp_set_abs)
  )
  (setq ai_ddvp_t nil)
  (set_tile "ddvp_val_x" (rtos ai_ddvp_b_curr 2 1))
  (set_tile "ddvp_val_xyp" (rtos ai_ddvp_a_curr 2 1))
  (action_tile "ddvp_abs_wcs" "(ai_ddvp_set_abs)")
  (action_tile "ddvp_rel_ucs" "(ai_ddvp_set_rel)")
  (action_tile "ddvp_image" "(ai_ddvp_image $x $y)")
  (action_tile "ddvp_val_x" "(ai_ddvp_set_b (distof $value))")
  (action_tile "ddvp_val_xyp" "(ai_ddvp_set_a (distof $value))")
  (action_tile "ddvp_set_plan" "(ai_ddvp_plan)")
  (action_tile "accept" "(ai_ddvp_do)")
  (action_tile "cancel" "(done_dialog 0)")
  (action_tile "help" "(help \"\" \"viewpoint_presets_dialog\")")
  (if (= (start_dialog) 1)
(if ai_ddvp_t
   (progn
      (command "._WORLDVIEW" ai_ddvp_wv)
      (command "._VPOINT" "_R"
               (strcat "<<" (rtos ai_ddvp_b_curr 2))
               (strcat "<<" (rtos ai_ddvp_a_curr 2))
      )
   )
)
  )
)

(defun c:VP ( / ai_ddvp_wv ai_ddvp_vdir_base ai_ddvp_vdir_curr
                  ai_ddvp_bx ai_ddvp_ax ai_ddvp_by ai_ddvp_a_curr
                  ai_ddvp_b_curr ai_ddvp_a_base ai_ddvp_b_base ai_ddvp_p
                  ai_ddvp_t ai_ddvp_init ai_ddvp_a ai_ddvp_b
                  ai_ddvp_a_last ai_ddvp_b_last
                  app dcl_id old_cmd undo_init
               )

  ;; Set up error function.
  (setq old_cmd (getvar "cmdecho") ; save current setting of cmdecho
      old_error  *error*          ; save current error function
      *error* ai_error             ; new error function
  )

  (setvar "cmdecho" 0)

  (cond
   (  (not (ai_notrans)))                      ; transparent not OK
   (  (not (ai_acadapp)))                      ; ACADAPP.EXP xloaded?
   (  (not (setq dcl_id (ai_dcl "ddvpoint"))))  ; is .DCL file loaded?
   (T (ai_undo_push)
      (ddvpoint_main)                         ; proceed!
      (ai_undo_pop)
   )
  )

  (setq *error* old_error)
  (setvar "cmdecho" old_cmd)
  (princ)
)

(defun ddvpoint_main()

  (if (and (= 0 (getvar "TILEMODE"))
         (= 1 (getvar "CVPORT"))
   )
(princ "\n** Command not allowed in Paper space **")
(progn
   (if (not (new_dialog "ddvpoint" dcl_id))
      (exit)
   )
   (setq ai_ddvp_vdir_base (ai_ddvp_fixzero (getvar "VIEWDIR"))
         ai_ddvp_wv (getvar "WORLDVIEW")
         ai_ddvp_init T
   )
   (ai_ddvp_main)
)
  )
)

(princ "  DDVPOINT loaded.  ")
(princ)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;============================= Tran Ngoc Thang =================================
(defun c:zx () (command "zoom" ".5x"))
(defun c:zz () (command "zoom" "p"))
(defun c:za () (command "zoom" "a"))
(defun c:zd () (command "zoom" "d"))
(defun c:ze () (command "zoom" "e"))
(defun c:zr () (command "zoom" "" ""))
(defun c:vv () (command "ucs" "v"))
(defun c:co () (ssget) (command "copy" "p" "" "m"))
(defun c:c () (command "circle"))
(defun c:rt () (command "rotate"))
(defun c:3q () (ssget) (command "_rotate3d" "ANGDIR" "value" pause (princ)))
(defun c:30 () (ssget) (command "rotate" "p" "" pause "30"))
(defun c:-30 () (ssget) (command "rotate" "p" "" pause "-30"))
(defun c:45 () (ssget) (command "rotate" "p" "" pause "45"))
(defun c:r5 () (ssget) (command "rotate" "p" "" pause "5"))
(defun c:60 () (ssget) (command "rotate" "p" "" pause "60"))
(defun c:-60 () (ssget) (command "rotate" "p" "" pause "-60"))
(defun c:90 () (ssget) (command "rotate" "p" "" pause "90"))
(defun c:180 () (ssget) (command "rotate" "p" "" pause "180"))
(defun c:-45 () (ssget) (command "rotate" "p" "" pause "-45"))
(defun c:-90 () (ssget) (command "rotate" "p" "" pause "-90"))
(defun c:md () (ssget) (command "mirror" "p" "" pause pause "y"))
(defun c:fd () (command "find" "p" "" )(princ))(princ)

(defun c:VNI () (command "-style" "VNi-AUCHON" "VNI-vauchon" "225""1""0""n""n""n"))(princ)

(defun c:romantdim () (command "-style" "ROMANT-DIM" "romant,vnh.shx" "200""1""0""n""n""n"))(princ)
(defun c:romantext () (command "-style" "ROMANT-TEXT" "romant,vnh.shx" "200""1""0""n""n""n"))(princ)
(defun c:vnhelvthuong () (command "-style" "VNHELVLT-Thuong" "vnhelv,vnh.shx" "500""1""0""n""n""n"))(princ)
(defun c:vnhelvhoa () (command "-style" "VNHELVLT-Hoa" "vnhelvh,vnh.shx" "500""1""0""n""n""n"))(princ)
(defun c:truc () (command "-style" "TRUC" "impact" "0""1""0""n""n""n"))
(defun c:chu () (command "-style" "CAMBRIA" "Cambria" "200""1""0""n""n"))
(defun c:cot () (command "-style" "COTES" "Romand" """1""0""n""n"))

(defun c:an () (command "-style" ".AVANT" ".vnavant" "200""1""0""n""n"))
(defun c:ah () (command "-style" ".AVANTH" ".vnavanth" "200""1""0""n""n"))
(defun c:ha () (command "-style" ".ARIALH" ".vnarialh" "200""1""0""n""n"))
(defun c:na () (command "-style" ".ARIALNARROWH" ".vnarial narrowh""1200""1""0""n""n"))
(defun c:vn () (command "-style" ".VNTIME" ".vntime" "200""1""0""n""n"))
(defun c:vh () (command "-style" ".VNTIMEH" ".vntimeh" "200""1""0""n""n"))

(defun c:ps () (command "

SOUT" "CorelDraw-import-Photoshop" "W"))(princ);export the current view of a drawing as an EPS file

;free lisp by cadviet,cd2k44
;link bai viet http://www.cadviet.com/forum/index.php?showtopic=53830
(defun c:FTEXT (/ ent tstyle )
(command "undo" "be")
(setq ent (entsel "\n Pick text :"))
(setq TSTYLE (cdr (assoc 7 (entget (car ent)))))
(command "STYLE" TSTYLE "romant.shx,vnh.shx" "0" "1" "0" "N" "N" "n")
(setvar "TEXTSTYLE" Tstyle)
(command "undo" "end")
)
;Cam on cadviet nhieu 27-11-2023 04h15p36s (thanks cadviet)

;free lisp by cadviet,cd2k44
;link bai viet http://www.cadviet.com/forum/index.php?showtopic=53830
(defun c:Fvnh (/ ent tstyle )
(command "undo" "be")
(setq ent (entsel "\n Pick text :"))
(setq TSTYLE (cdr (assoc 7 (entget (car ent)))))
(command "STYLE" TSTYLE "vnhelvh.shx,vnh.shx" "0" "1" "0" "N" "N" "n")
(setvar "TEXTSTYLE" Tstyle)
(command "undo" "end")
)

;free lisp by cadviet,cd2k44
;link bai viet http://www.cadviet.com/forum/index.php?showtopic=53830
(defun c:Chbg (/ ent tstyle )
(command "undo" "be")
(setq ent (entsel "\n Pick text :"))
(setq TSTYLE (cdr (assoc 7 (entget (car ent)))))
(command "STYLE" TSTYLE "chhbg.shx,vnh.shx" "0" "1" "0" "N" "N" "n")
(setvar "TEXTSTYLE" Tstyle)
(command "undo" "end")
)

;free lisp by cadviet,cd2k44
;link bai viet http://www.cadviet.com/forum/index.php?showtopic=53830
(defun c:Chsm (/ ent tstyle )
(command "undo" "be")
(setq ent (entsel "\n Pick text :"))
(setq TSTYLE (cdr (assoc 7 (entget (car ent)))))
(command "STYLE" TSTYLE "chhsml.shx,vnh.shx" "0" "1" "0" "N" "N" "n")
(setvar "TEXTSTYLE" Tstyle)
(command "undo" "end")
)

;free lisp by cadviet,cd2k44
;link bai viet http://www.cadviet.com/forum/index.php?showtopic=53830
(defun c:Fttf (/ ent tstyle )
(command "undo" "be")
(setq ent (entsel "\n Pick text :"))
(setq TSTYLE (cdr (assoc 7 (entget (car ent)))))
(command "STYLE" TSTYLE "Cambria.ttf" "0" "1" "0" "N" "N" "n")
(setvar "TEXTSTYLE" Tstyle)
(command "undo" "end")
)

;;; ============================================
;;;
;;; LISP Creater Tao Duong Dan AUTOCAD2000
;;;
;;; ============================================

;;; ============================================
;;;
;;;       CREATING FROM AUTOCAD2000
;;;    Tran Ngoc Thang - Sinh 03-05-1976
;;; ============================================

(setvar "MEASUREMENT"1);Bien So SCALE Cua BHATCH
;(setvar "DYNMODE"2);Bien So An Hien COMMAND LINE
;(setvar "VTENABLE"0);VTOPTIONS Enable Animation for Pan and Zoom
(setvar "INSUNITS"4)
(setvar "ANGBASE"0)
(setvar "ANGDIR"0)
(setvar "AUNITS"0)
(setvar "AUPREC"8)
(setvar "LUNITS"2)
(setvar "LUPREC"8)
(setvar "ACADLSPASDOC"1)
(setvar "pickbox"5)
(setvar "blipmode"0)
(setvar "mirrtext"0)
(setvar "cursorsize"100)
(setvar "ZOOMFACTOR"75)
(setvar "LTSCALE" 10)
(setvar "lwunits"1)
(setvar "DIMBLK" "Closed")
(setvar "DIMGAP"0.0693)
(setvar "DIMASZ"0.20)
(setvar "DIMCEN"0.2)
(setvar "DIMDLI"0.1)
(setvar "DIMEXE"0.0693)
(setvar "DIMEXO"0.25)
(setvar "DIMDEC"0)
(setvar "DIMTIX" 1)
(setvar "DIMTXT" 0.099)
(setvar "DIMCLRT" 7)
(setvar "DIMTVP" 1)
(setvar "DIMJUST" 0)
(setvar "DIMTIH" 0)
(setvar "DIMTOFL" 1)
(setvar "DIMSCALE" 1111.1111)

(defun c:zp ()  (command "'.zoom" "p"))
(defun c:zz ()  (command "'.zoom" "p"))
(defun c:ze ()  (command "'.zoom" "e"))
(defun c:za ()  (command "'.zoom" "a"))
(defun c:zd ()  (command "'.zoom" "d"))
(DEFUN C:ZZZ () (COMMAND "ZOOM" ".25X"))
(DEFUN C:ZX  () (COMMAND "ZOOM" "2X"))
(defun c:de () (command "ddedit")(princ))
(defun c:dda () (command "Dimaligned"))
(defun c:ddb () (command "Dimabaseline"))
(defun c:ddc () (command "Dimcontinue"))
(defun c:dde () (command "Dimtedit"))
(defun c:ddf () (command "Ddattdef"))
(defun c:ddi () (command "Dimdiameter"))
(defun c:ddl () (command "Dimlinear"))
(defun c:ddn () (command "Dimangular"))
(defun c:ddo () (command "Dimordinate"))
(defun c:ddr () (command "Dimradius"))
(defun c:dds () (command "Dimstyle"))

(defun c

U () (command "dim1" "up" "select" "exit" pause ))(princ)
(defun c

H () (command "Dim1" "home" "select" "exit" pause))(princ)
(defun c:UU () (command "dim1""update""all"))
(defun c:ded() (command "dim1""tedit"))
(defun c:da () (command "dim1""ali"))
(defun c:dll() (command "dim1""l"))
(defun c:dan() (command "dim1""an"))
(defun c:d1 () (command "dim1""ra"))
(defun c:n () (command "dim1""new"))

(DEFUN C

E () (COMMAND "

EDIT"))
(DEFUN C

L () (COMMAND "

LINE"))
(defun c:dd () (command "dist")(princ))
(defun c:w () (command "pedit" pause "w" "au")(princ))
(defun c:pg  () (command "polygon" "polygon"))
(defun c:el  () (command "ellipse"))
(defun c:xe  () (command "explode"))
(defun c:eex  () (command "extrude"))
(defun c:xg  () (command "xline""a"))
(defun c:xh  () (command "xline""h"))
(defun c:xv  () (command "xline""v"))

(defun c

c () (command "osnap""cen"))
(defun c

d () (command "osnap""nod"))
(defun c

e () (command "osnap""end"))
(defun c

i () (command "osnap""int"))
(defun c

r () (command "osnap""per"))
(defun c

n () (command "osnap""none"))
(defun c

q () (command "osnap""qua"))
(defun c

m () (command "osnap""mid"))
(defun c

t () (command "osnap""tan"))
(defun c

in () (command "osnap""ins"))
(defun c:oa () (command "osnap""nea"))
(defun c:ol () (command "osnap" "End,Mid,Cen,Node,Nea,Int,Perp,Qua")(princ))
;(defun c:du () (command "dim1" "up" "s" "pick" "other"))
;(defun c:nn () (command "new" "y" ))

(defun c:/ () (command "limits"))
(defun c:`1 () (command "region"))
(defun c:`2 () (command "subtract"))
(defun c:`3 () (command "union"))
(defun c:`4 () (command "intersect"))
(defun c:`c () (command "cal"))
(defun c:`g () (command "

olygon"))

(defun c:lmi() (command "LIMMAX" pause "" "zoom" "all" )(princ))
(defun c:drt () (command "DRAWORDERCTL" pause "Integer" "" "" )(princ))
(defun c:ip () (ssget) (command "print,_plot" ))(princ)

(defun c:ddm () (command "ddlmodes" pause))

(defun c:sha () (command "shade" pause))

(defun c:sr1 () (command "surftab1" "p" "" pause))
(defun c:sr2 () (command "surftab2" "p" "" pause))

(defun c:ad () (command "audit""y"))
(defun c:q () (command "quit"))

(defun c:30 () (ssget) (command "rotate" "p" "" pause "30"))
(defun c:-30 () (ssget) (command "rotate" "p" "" pause "-30"))
(defun c:45 () (ssget) (command "rotate" "p" "" pause "45"))
(defun c:-45 () (ssget) (command "rotate" "p" "" pause "-45"))
(defun c:60 () (ssget) (command "rotate" "p" "" pause "60"))
(defun c:-60 () (ssget) (command "rotate" "p" "" pause "-60"))
(defun c:90 () (ssget) (command "rotate" "p" "" pause "90"))
(defun c:-90 () (ssget) (command "rotate" "p" "" pause "-90"))
(defun c:180 () (ssget) (command "rotate" "p" "" pause "180"))

(defun c:u3 () (command "ucs""3"))
(defun c:ue () (command "ucs""o""end"))
(defun c:ui () (command "ucs""o""int"))
(defun c:um () (command "ucs""o""mid"))
(defun c:uc () (command "ucs""o""cen"))
(defun c:uq () (command "ucs""o""qua"))
(defun c:3s () (command "ucs""3"))
(defun c:sx () (command "ucs""s"))
(defun c:sf () (command "ucs""o"))
(defun c:sz () (command "ucs""p"))
(defun c:sr () (command "ucs""r"))
(defun c:sw () (command "ucs""w"))
(defun c:fv () (command "ucs""v"))
(defun c:ux () (command "ucs""x"))
(defun c:uux () (command "ucs""x""90"))
(defun c:xxu () (command "ucs""x""-90"))
(defun c:uy () (command "ucs""y"))
(defun c:uuy () (command "ucs""y""90"))
(defun c:yyu () (command "ucs""y""-90"))
(defun c:uz () (command "ucs""z"))
(defun c:uuz () (command "ucs""z""90"))
(defun c:zzu () (command "ucs""z""-90"))
(defun c:uci () (command "ucsicon" "

roperties" ))(princ)
(defun c:ucm () (command "ucsman" ))(princ)

(defun c:sa () (command "vpoint""_non""-1,-1,1"))
(defun c:sd () (command "vpoint""_non""1,-1,1"))
(defun c:se () (command "vpoint""_non""1,1,1"))
(defun c:sq () (command "vpoint""_non""-1,1,1"))
(defun c:vc () (command "plan"""))
(defun c:vd () (command "dview""all"))

(defun c:TT0 () (command "tilemode""0"))
(defun c:TT1 () (command "tilemode""1"))

(defun c:vt () (command "vpoint""_non""0,0,1"))
(defun c:vb () (command "vpoint""_non""0,0,-1"))
(defun c:vl () (command "vpoint""_non""-1,0,0"))
(defun c:vr () (command "vpoint""_non""1,0,0"))
(defun c:vf () (command "vpoint""_non""0,-1,0"))
(defun c:vk () (command "vpoint""_non""0,1,0"))

(DEFUN C:MM () (COMMAND "MIRROR"))
(DEFUN C:MP () (COMMAND "MOVE" "

"))

(defun c:mee (/ a)
  (setq a (ssget))(command "move"a"""end"pause"end"))
(defun c:mc (/ a)
  (setq a (ssget))(command "move"a"""cen"pause"cen"))
(defun c:cc (/ a)
  (setq a (ssget))(command "copy"a"""m"))
(defun c:ce (/ a)
  (setq a (ssget))(command "copy"a"""m""end"pause"end"))
(defun c:cn (/ a)
  (setq a (ssget))(command "copy"a"""m""cen"pause"cen"))
(defun c:tl ()(command "trim""l"""))
(defun c:tf (/ a)
(setq a (ssget))(command "trim"a"""f"))
(defun c:el ()(command "extend""l"""))
(defun c:ef (/ a)
  (setq a (ssget))(command "extend"a"""f"))

(DEFUN C:110 ()(princ "\nChon doi tuong can offset ra 110.......") (COMMAND "offset" "110"))
(DEFUN C:220 ()(princ "\nChon doi tuong can offset ra 220.......")(COMMAND "offset" "220"))
(DEFUN C:330 ()(princ "\nChon doi tuong can offset ra 330.......")(COMMAND "offset" "330"))
(DEFUN C:400 ()(princ "\nChon doi tuong can offset ra 400.......")(COMMAND "offset" "400"))
(DEFUN C:55 ()(princ "\nChon doi tuong can offset ra 55.......") (COMMAND "offset" "55"))
(DEFUN C:600 ()(princ "\nChon doi tuong can offset ra 600.......") (COMMAND "offset" "600"))
(DEFUN C:700 ()(princ "\nChon doi tuong can offset ra 700.......") (COMMAND "offset" "700"))
(DEFUN C:800 ()(princ "\nChon doi tuong can offset ra 800.......") (COMMAND "offset" "800"))
(DEFUN C:900 ()(princ "\nChon doi tuong can offset ra 900.......") (COMMAND "offset" "900"))
(DEFUN C:1200 ()(princ "\nChon doi tuong can offset ra 1200.......") (COMMAND "offset" "1200"))
(DEFUN C:1500 ()(princ "\nChon doi tuong can offset ra 1500.......") (COMMAND "offset" "1500"))
(DEFUN C:1800 ()(princ "\nChon doi tuong can offset ra 1800.......") (COMMAND "offset" "1800"))
(DEFUN C:2400 ()(princ "\nChon doi tuong can offset ra 2400.......") (COMMAND "offset" "2400"))
(DEFUN C:3000 ()(princ "\nChon doi tuong can offset ra 3000.......") (COMMAND "offset" "3000"))
(DEFUN C:3600 ()(princ "\nChon doi tuong can offset ra 3600.......") (COMMAND "offset" "3600"))
(DEFUN C:4200 ()(princ "\nChon doi tuong can offset ra 4200.......") (COMMAND "offset" "4200"))
(DEFUN C:5000 ()(princ "\nChon doi tuong can offset ra 5000.......") (COMMAND "offset" "5000"))

(defun c:mla () (command "-mledit""av"))
(defun c:mlc () (command "-mledit""mc"))
(defun c:mld () (command "-mledit""dv"))
(defun c:mle () (command "mline""end"pause"end"))
(defun c:mli () (command "-mledit""ca""int"pause"int"))
(defun c:mlj () (command "-mledit""cj"))
(defun c:mlt () (command "-mledit""mt"))
(defun c:mlk () (command "-mledit""ca""end"pause"end"))
(defun c:mlw () (command "-mledit""wa"))

(DEFUN C

CA () (COMMAND "DVIEW" "all" "" "CA"))
(DEFUN C

PA () (COMMAND "DVIEW" "all" "" "

A"))
(DEFUN C

PO () (COMMAND "DVIEW" "all" "" "

O"))
(DEFUN C

DD () (COMMAND "DVIEW" "all" "" "D"))
(DEFUN C

Z  () (COMMAND "DVIEW" "all" "" "Z"))

(defun c:p0 () (command "pline""""w""0""0"))
(defun c:ot  () (command "offset""t"))
(defun c:t  () (command "mtext"pause"j""bl""h"pause))
(defun c:uo () (command "ucs""ob"pause))
(defun c:f0 () (command "fillet""r""0"))
(defun c:fr () (command "fillet""r"))

;CHAMFER
(defun c:cf () (command "chamfer"))
(defun c:cfd () (command "chamfer" "d"))
(defun c:cf0 () (command "chamfer" "d" "0" ""))

;FILLET
(defun c:f () (command "fillet"))
(defun c:fr () (command "fillet" "r"))
(defun c:f0 () (command "fillet" "r" "0"))

(defun c:OO  () (command "oops"))
(defun c:dln  () (command "dimlinear"))
(defun c:dan  () (command "dimaligned"))
(defun c:ddc  () (command "dimcontinue"))

(defun c:sc () (command "scale" "auto"))
(DEFUN C:XO  () (COMMAND "snapang"))
(defun c:cc (/ a)
  (setq a (ssget))(command "copy"a"""m"))

(defun c

J (/ a)
  (setq a (ssget))(command "pedit"a"""j""all""y"))
(defun c:JJ (/ a)
  (setq a (ssget))(command "pedit"a"""j""y"))
(defun c:TN (/ a)
  (setq a (ssget))(command "change"a"""p""T"))

;================== Tran Ngoc Thang - Sinh 03-05-1976 - Suu Tam - Tu nam 2000 - Hoc nam cuoi KTS . DHXD ====================

(defun C:IB ()(setvar"cmdecho"1)
  (setq pt(cadr(entsel"\nSelect Block:")))
  (setq e1(ssget pt))
  (setq e2 (entget (ssname e1 0)))
  (setq blname (cdr(assoc 2 e2)))
  (setq oer *error* *error* err2)(command ".insert" blname))

(defun c:II ()
(setvar "cmdecho" 0)
(setq olderr *error* *error* myerror)
(prompt "\nSelect objects: ")
(command "select" "au" pause)
(setq sstxt (ssget "p")
      sslen (sslength sstxt)
      ctr 0
)
(command ".undo" "mark")
(while (< ctr sslen)
         (setq listxt (entget (ssname sstxt ctr))
               txttxt (cdr (assoc 1 listxt))
               enttxt (cdr (assoc 0 listxt))
         )
         (if (= enttxt "TEXT")
            (progn
               (setq testxt (substr txttxt 1 3))
               (if (or (= testxt "%%C") (= testxt "%%C"))
                     (setq newtxt (substr txttxt 4))
                     (setq newtxt (strcat "%%C" txttxt))
               )
               (setq listxt (subst (cons 1 newtxt) (assoc 1 listxt) listxt))
               (entmod listxt)
            )
         )
         (setq ctr (1+ ctr))
)
(setq *error* olderr)
(setvar "cmdecho" 1)
(princ)
)

(defun c

G ()
(setvar "cmdecho" 0)
(setq olderr *error* *error* myerror)
(prompt "\nSelect objects: ")
(command "select" "au" pause)
(setq sstxt (ssget "p")
      sslen (sslength sstxt)
      ctr 0
)
(command ".undo" "mark")
(while (< ctr sslen)
         (setq listxt (entget (ssname sstxt ctr))
               txttxt (cdr (assoc 1 listxt))
               enttxt (cdr (assoc 0 listxt))
         )
         (if (= enttxt "TEXT")
            (progn
               (setq testxt (substr txttxt 1 3))
               (if (or (= testxt "%%d") (= testxt "%%d"))
                     (setq newtxt (substr txttxt 4))
                     (setq newtxt (strcat txttxt "%%dC" ))
               )
               (setq listxt (subst (cons 1 newtxt) (assoc 1 listxt) listxt))
               (entmod listxt)
            )
         )
         (setq ctr (1+ ctr))
)
(setq *error* olderr)
(setvar "cmdecho" 1)
(princ)
)

(defun c

I ()
(setvar "cmdecho" 0)
(setq olderr *error* *error* myerror)
(prompt "\nSelect objects: ")
(command "select" "au" pause)
(setq sstxt (ssget "p")
      sslen (sslength sstxt)
      ctr 0
)
(command ".undo" "mark")
(while (< ctr sslen)
         (setq listxt (entget (ssname sstxt ctr))
               txttxt (cdr (assoc 1 listxt))
               enttxt (cdr (assoc 0 listxt))
         )
         (if (= enttxt "TEXT")
            (progn
               (setq testxt (substr txttxt 1 3))
               (if (or (= testxt "%%p") (= testxt "%%p"))
                     (setq newtxt (substr txttxt 4))
                     (setq newtxt (strcat "%%p" txttxt))
               )
               (setq listxt (subst (cons 1 newtxt) (assoc 1 listxt) listxt))
               (entmod listxt)
            )
         )
         (setq ctr (1+ ctr))
)
(setq *error* olderr)
(setvar "cmdecho" 1)
(princ)
)

(Defun c:CB (/ a)
(setq olderr *error* *error* myerror)
(setq ocmd (getvar "cmdecho"))
(setq oblp (getvar "blipmode"))
(setvar "cmdecho" 0)
(setq a (ssget))
(command "CHPROP" a "" "C" "bylayer" "")
(setvar "cmdecho" ocmd)
(setvar "blipmode" oblp)
(setq *error* olderr)
(princ)
)

(defun c

CC (/ co43 obj23 la23)
(setvar "cmdecho" 0)
(setq co43 (getstring "\nNew color : "))
(setq obj23 (car (entsel "\nPick object on desired layer: ")))
(if obj23 (progn
         (setq obj23 (entget obj23))
         (setq la23 (cdr (assoc 8 obj23)))
         (command "layer" "c" co43 la23 "")
      )
)
(prompt (strcat  "\nLayer has changed..." la23))
(setvar "cmdecho" 1)
(princ)
)

(Defun c:RP (/ a)
(setq olderr *error* *error* myerror)
(setq ocmd (getvar "cmdecho"))
(setq oblp (getvar "blipmode"))
(setvar "cmdecho" 0)
(prompt (strcat "\nUSE: Delete object(s) belonging to"
               " the layer of the entity picked...!"))
(setq a (entsel "\nPick the entity with the desired layer to delete: "))
(if (/= a nil)
   (progn (setq a (cdr (assoc 8 (entget (car a )))))
   (command "Erase" (ssget "x" (cons (cons 8 (eval a)) tempword)) ""))
   (prompt "\nNo entity selected!"))
(setvar "cmdecho" ocmd)
(setvar "blipmode" oblp)
(setq *error* olderr)
(princ)
)

(DEFUN C:WL(/ SSET NET SSL M)
(PRINC "\nSelect lines :")
(SETQ SSET (SSGET))
(IF (/= NIL SSET) (PROGN
(SETQ SSL (SSLENGTH SSET))
(INITGET 4)
(SETQ NET (GETREAL "New width : "))
(IF (/= NIL NET)
(WHILE (> SSL 0)
   (SETQ M (SSNAME SSET (SETQ SSL (- SSL 1)) ))
   (IF (= (CDR (ASSOC '0 (ENTGET M))) "LINE")
      (COMMAND "

EDIT" M "Y" "W" NET "")
   )
)
)))
(PRINC)
)

(defun C:MML ()
  (princ "\nSelect objects to move to another Layer.")
  (setq ss (ssget))
  (SETQ UL1(GETSTRING "\nLayer to move entities to : "))
  (setq counter 0)
  (prompt "Moving to layer.....")(princ ul1)
  (setq e (ssname ss counter))
  (setq l (cdr (assoc 8 (entget e))))
  (setq S (ssget "X" (list (cons 8 l))))
  (command "CHANGE" ss "" "

" "LA" UL1 "")
  (setq counter (+ counter 1))
(princ)
)

;;; ================================ GHI CHU ============================
;;; ======== Phai Vao STYLE Tao LAYER Ten TEXT + Phai Dat Height ========
;;; =======================Thuong Dung Font Romant.vnh===================
;;;==================== Tran Ngoc Thang - Sinh 03-05-1976================

(defun c:RS (/ pta ptb ptc ptd X Y X1 Y1 rmsz pl1)
  (setq oer *error* *error* err2)
  (PROMPT "\n(VNI-TTF)(D)ining room. (S)torage. c(L)oset. (C)onference. (O)ffice. (K)itchen. (B)ath. (M)aster Bedroom. ")
  (SETQ Cpt(GETSTRING "\n (RomanT.vnh)(DD).(SS).(LL).(CC).(OW).(KK).(BB).(MM). (Vni-SHX)(oD).(oS).(oL).(oC).(oww).(oK).(oB).(oM)."))
  (IF(OR(= Cpt "K")(= cpt "k"))(SETQ CPT ' "Nhaø Beáp"))
  (IF(OR(= cpt "B")(= cpt "b"))(SETQ CPT ' "Phoøng Veä Sinh"))
  (IF(OR(= cpt "C")(= cpt "c"))(SETQ CPT ' "Phoøng Hoïp"))
  (IF(OR(= cpt "O")(= cpt "o"))(SETQ CPT ' "Phoøng Laøm Vieäc"))
  (IF(OR(= cpt "M")(= cpt "m"))(SETQ CPT ' "Phoøng Nguû"))
  (IF(OR(= cpt "D")(= cpt "d"))(SETQ CPT ' "Phoøng Beáp + AÊn"))
  (IF(OR(= cpt "S")(= cpt "s"))(SETQ CPT ' "Nhaø Kho"))
  (IF(OR(= cpt "L")(= cpt "l"))(SETQ CPT ' "Phoøng Ñeå Ñoà"))

  (IF(OR(= Cpt "KK")(= cpt "kk"))(SETQ CPT ' "Nhµ BÕp"))
  (IF(OR(= cpt "BB")(= cpt "bb"))(SETQ CPT ' "Phßng VÖ Sinh"))
  (IF(OR(= cpt "CC")(= cpt "cc"))(SETQ CPT ' "Phßng Häp"))
  (IF(OR(= cpt "OW")(= cpt "ow"))(SETQ CPT ' "Phßng Lµm ViÖc"))
  (IF(OR(= cpt "MM")(= cpt "mm"))(SETQ CPT ' "Phßng Ngñ"))
  (IF(OR(= cpt "DD")(= cpt "dd"))(SETQ CPT ' "Phßng BÕp-¡n"))
  (IF(OR(= cpt "SS")(= cpt "ss"))(SETQ CPT ' "Nhµ Kho"))
  (IF(OR(= cpt "LL")(= cpt "ll"))(SETQ CPT ' "Phßng §Ó §å"))

  (IF(OR(= Cpt "oK")(= cpt "ok"))(SETQ CPT '"NHA/F BE/M/SP"))
  (IF(OR(= cpt "oB")(= cpt "ob"))(SETQ CPT '"PHO/F/NG TA/W/SM"))
  (IF(OR(= cpt "oC")(= cpt "oc"))(SETQ CPT '"PHO/FNG HO/JP"))
  (IF(OR(= cpt "oww")(= cpt "oww"))(SETQ CPT '"P.LA/FM VI/E/M/JC"))
  (IF(OR(= cpt "oM")(= cpt "om"))(SETQ CPT '"PHO/FNG NGU/R"))
  (IF(OR(= cpt "oD")(= cpt "od"))(SETQ CPT '"PHO/FNG A/WN"))
  (IF(OR(= cpt "oS")(= cpt "os"))(SETQ CPT '"NHA/F KHO"))
  (IF(OR(= cpt "oL")(= cpt "ol"))(SETQ CPT '"PHO/FNG /DO/M/F"))
(setq pta (getpoint
"\nPick first corner. : "))
  (setq ptb (getcorner pta
"\nPick second corner. : "))
  (setq ptc (list (car ptb)(cadr pta)))
  (setq ptd (list (car pta)(cadr ptb)))
  (setq ang (angle pta ptb))
  (setq d1 (/(distance pta ptb) 2))
  (setq cp (polar pta (- ang (dtr 0)) d1))
  (setq X (distance pta ptc))
  (setq Y (distance pta ptd))
  (setq X1 (rtos x 2 1))
  (setq Y1 (rtos y 2 1))
  (setq rmsz (strcat "(" X1 " x " Y1 ")"))
  (command "TEXT" "c" cp "0" CPT "ROMANT-TEXT" "" rmsz))
  (defun dtr (angg)
  (* pi (/ angg 180.0)))

(defun c:ZS (/ pta ptb rmsz pl1)
  (setq oer *error* *error* err2)
  (PROMPT "\n (Vni-SHX-TTF)floorp(L)(oL)an.(E)(oE)levation.(S)(oS)ection.(M)(oM)planFoundation.(C)(oC)Found.(K)(oK)Khung.(P)(oP)View3D.")
  (SETQ Cpt(GETSTRING "\n (RomanT.Vnh)(LL)floorplan.(EE)elevation.(SS)section.(BM)planFoundation.(CM)foundation.(KC)Structure.(PP)perspective."))

  (IF(OR(= Cpt "LL")(= cpt "ll"))(SETQ CPT ' "MÆt B»ng TÇng 1 : TØ LÖ - 1:100"))
  (IF(OR(= cpt "EE")(= cpt "ee"))(SETQ CPT ' "MÆt §øng Trôc ?-? : TØ LÖ - 1:100"))
  (IF(OR(= cpt "SS")(= cpt "ss"))(SETQ CPT ' "MÆt C¾t A-A : TØ LÖ - 1:100"))
  (IF(OR(= cpt "BM")(= cpt "bm"))(SETQ CPT ' "MÆt B»ng Mãng : TØ LÖ - 1 : 100"))
  (IF(OR(= cpt "CM")(= cpt "cm"))(SETQ CPT ' "MÆt C¾t Mãng : TØ LÖ - 1 : 100"))
  (IF(OR(= cpt "KC")(= cpt "kc"))(SETQ CPT ' "KÕt CÊu Khung Däc Nhµ : TØ LÖ - 1 : 100"))
  (IF(OR(= cpt "PP")(= cpt "pp"))(SETQ CPT ' "Phèi C¶nh Mét Gãc Nh×n"))

  (IF(OR(= Cpt "oL")(= cpt "ol"))(SETQ CPT ' "MAËT BAÈNG TAÀNG 1 : TÆ LEÄ - 1:100"))
  (IF(OR(= cpt "oE")(= cpt "oe"))(SETQ CPT ' "MAËT ÑÖÙNG TRUÏC ?-? : TÆ LEÄ - 1:100"))
  (IF(OR(= cpt "oS")(= cpt "os"))(SETQ CPT ' "MAËT CAÉT A-A : TÆ LEÄ - 1:100"))
  (IF(OR(= cpt "oM")(= cpt "om"))(SETQ CPT ' "MAËT BAÈNG MOÙNG : TÆ LEÄ - 1 : 100"))
  (IF(OR(= cpt "oC")(= cpt "oc"))(SETQ CPT ' "MAËT CAÉT MOÙNG : TÆ LEÄ - 1 : 100"))
  (IF(OR(= cpt "oK")(= cpt "ok"))(SETQ CPT ' "KEÁT CAÁU KHUNG DOÏC NHAØ : TÆ LEÄ - 1 : 100"))
  (IF(OR(= cpt "oP")(= cpt "op"))(SETQ CPT ' "PHOÁI CAÛNH MOÄT GOÙC NHÌN"))

  (IF(OR(= Cpt "L")(= cpt "l"))(SETQ CPT '"MA/W/JT BA/W/FNG TA/M/FNG 1 : TI/R LE/M/J - 1:100"))
  (IF(OR(= cpt "E")(= cpt "e"))(SETQ CPT '"MA/W/JT /D/}/SNG TRU/JC ?-? : TI/R LE/M/J - 1:100"))
  (IF(OR(= cpt "S")(= cpt "s"))(SETQ CPT '"MA/W/JT CA/W/ST A-A TI/R : LE/M/J - 1:100"))
  (IF(OR(= Cpt "M")(= cpt "m"))(SETQ CPT '"MA/W/JT BA/W/FNG MO/SNG : TI/R LE/M/J - 1:100"))
  (IF(OR(= Cpt "C")(= cpt "c"))(SETQ CPT '"MA/W/JT CA/W/ST MO/SNG : TI/R LE/M/J - 1:100"))
  (IF(OR(= Cpt "K")(= cpt "k"))(SETQ CPT '"KE/M/S/T CA/M/SU KHUNG DO/JC NHA/F : TI/R LE/M/J - 1:100"))
  (IF(OR(= cpt "P")(= cpt "p"))(SETQ CPT '"PHO/M/SI CA/R/NH MO/M/JT GO/SC NHI/FN"))
(setq pta (getpoint
"\nPick first corner. : "))
  (setq ptb (getcorner pta
"\nPick second corner. : "))
  (setq ptc (list (car ptb)(cadr pta)))
  (setq ptd (list (car pta)(cadr ptb)))
  (setq ang (angle pta ptb))
  (setq d1 (/(distance pta ptb) 2))
  (setq cp (polar pta (- ang (dtr 0)) d1))
  (command "TEXT" "c" cp "0" CPT "ROMANT-TEXT" "" rmsz))
  (defun dtr (angg)
  (* pi (/ angg 180.0)))

;;; ================================ GHI CHU ============================
;;; ======== Phai Vao STYLE Tao LAYER Ten TEXT + Phai Dat Height ========
;;; =======================Thuong Dung Font Romant.vnh===================
;;;==================== Tran Ngoc Thang - Sinh 03-05-1976================

(defun c:RRS (/ pta ptb ptc ptd X Y X1 Y1 rmsz pl1)
  (setq oer *error* *error* err2)
  (PROMPT "\n(Vni-SHX-TTF)(oD)(D)ining room. (oS)(S)torage. c(oL)(L)oset. (oC)(C)onference. (oWW)(O)ffice. (oK)(K)itchen. (oB)(B)ath. ")
  (SETQ Cpt(GETSTRING "\n(RomanT.Vnh)(M)aster Bedroom. (DD). (SS). (LL). (CC). (OO). (KK). (BB). (MM). "))
  (IF(OR(= Cpt "K")(= cpt "k"))(SETQ CPT ' "Nhaø Beáp"))
  (IF(OR(= cpt "B")(= cpt "b"))(SETQ CPT ' "Phoøng Veä Sinh"))
  (IF(OR(= cpt "C")(= cpt "c"))(SETQ CPT ' "Phoøng Hoïp"))
  (IF(OR(= cpt "O")(= cpt "o"))(SETQ CPT ' "Phoøng Laøm Vieäc"))
  (IF(OR(= cpt "M")(= cpt "m"))(SETQ CPT ' "Phoøng Nguû"))
  (IF(OR(= cpt "D")(= cpt "d"))(SETQ CPT ' "Phoøng Beáp + AÊn"))
  (IF(OR(= cpt "S")(= cpt "s"))(SETQ CPT ' "Nhaø Kho"))
  (IF(OR(= cpt "L")(= cpt "l"))(SETQ CPT ' "Phoøng Ñeå Ñoà"))

  (IF(OR(= Cpt "KK")(= cpt "kk"))(SETQ CPT ' "Nhµ BÕp"))
  (IF(OR(= cpt "BB")(= cpt "bb"))(SETQ CPT ' "Phßng VÖ Sinh"))
  (IF(OR(= cpt "CC")(= cpt "cc"))(SETQ CPT ' "Phßng Häp"))
  (IF(OR(= cpt "OO")(= cpt "oo"))(SETQ CPT ' "Phßng Lµm ViÖc"))
  (IF(OR(= cpt "MM")(= cpt "mm"))(SETQ CPT ' "Phßng Ngñ"))
  (IF(OR(= cpt "DD")(= cpt "dd"))(SETQ CPT ' "Phßng BÕp-¡n"))
  (IF(OR(= cpt "SS")(= cpt "ss"))(SETQ CPT ' "Nhµ Kho"))
  (IF(OR(= cpt "LL")(= cpt "ll"))(SETQ CPT ' "Phßng §Ó §å"))

  (IF(OR(= Cpt "oK")(= cpt "ok"))(SETQ CPT '"NHA/F BE/M/SP"))
  (IF(OR(= cpt "oB")(= cpt "ob"))(SETQ CPT '"PHO/F/NG TA/W/SM"))
  (IF(OR(= cpt "oC")(= cpt "oc"))(SETQ CPT '"PHO/FNG HO/JP"))
  (IF(OR(= cpt "oww")(= cpt "oww"))(SETQ CPT '"P.LA/FM VI/E/M/JC"))
  (IF(OR(= cpt "oM")(= cpt "om"))(SETQ CPT '"PHO/FNG NGU/R"))
  (IF(OR(= cpt "oD")(= cpt "od"))(SETQ CPT '"PHO/FNG A/WN"))
  (IF(OR(= cpt "oS")(= cpt "os"))(SETQ CPT '"NHA/F KHO"))
  (IF(OR(= cpt "oL")(= cpt "ol"))(SETQ CPT '"PHO/FNG /DO/M/F"))

(setq pta (getpoint
"\nPick first corner. : "))
  (setq ptb (getcorner pta
"\nPick second corner. : "))
  (setq ptc (list (car ptb)(cadr pta)))
  (setq ptd (list (car pta)(cadr ptb)))
  (setq ang (angle pta ptb))
  (setq d1 (/(distance pta ptb) 2))
  (setq cp (polar pta (- ang (dtr 0)) d1))
  (setq X (distance pta ptc))
  (setq Y (distance pta ptd))
  (setq X1 (rtos x 2 1))
  (setq Y1 (rtos y 2 1))
  (setq rmsz (strcat "(" X1 " x " Y1 ")"))
  (command "TEXT" "c" cp "0" CPT "text" "" rmsz))
  (defun dtr (angg)
  (* pi (/ angg 180.0)))

;;; ================================ GHI CHU ============================
;;; ======== Phai Vao STYLE Tao LAYER Ten TEXT + Phai Dat Height ========
;;; =======================Thuong Dung Font Romant.vnh===================

(defun c:GS (/ a b c d)
  (graphscr)
  (prompt "\nSelect text to set style....")
  (setq a (entsel))
  (setq b (entget (car a)))
  (setq c (cdr (assoc 7 b)))
  (setq d (cdr (assoc 40 b)))
  (command "style" c "" d "" "" "" ""))
  (princ "\nType GS to set text style.")

(defun c:RC (/ olderr ocmd oblp pt1 pt2 pt3 pt4 l w)
  (setq olderr *error* *error* myerror)
  (setq ocmd (getvar "cmdecho"))
  (setq oblp (getvar "blipmode"))
  (setvar "cmdecho" 0)
  (initget 1)                      ;3D point can't be null
  (Setq pt1 (getpoint (strcat "\nCorner of rectangle or square: ")))
  (setvar "ORTHOMODE" 1)
  (initget 7)                      ;Length can't be 0, neg, or null
  (Setq l (getdist pt1 "\nLength: "))
  (Setq pt2 (list (+ (car pt1) l) (cadr pt1) (caddr pt1)))
  (grdraw pt1 pt2 2)
  (initget 7 "Square")             ;Width can't be 0, neg, or null
  (setq w (getdist pt1 "\nSquare/<Width>: "))
  (if (= w "Square")
   (setq w l)
  )
  (setq pt3 (list (car pt2) (+ (cadr pt2) w) (caddr pt2)))
  (setq pt4 (list (car pt1) (+ (cadr pt1) w) (caddr pt1)))
  (grdraw pt2 pt3 2)
  (grdraw pt3 pt4 2)
  (grdraw pt4 pt1 2)
  (setvar "ORTHOMODE" 0)
  (command "pline"  pt1 pt2 pt3 pt4 "close")
  (setvar "cmdecho" ocmd)
  (setvar "blipmode" oblp)
  (setq *error* olderr)             ; Restore old *error* handler
  (princ)
)

(defun c:SG (/ ent pt1 pt2 ang)
  (setq cmd (getvar "cmdecho"))
  (setvar "cmdecho" 1)
  (prompt (strcat"\nSnap angle will be set to angle of line"))
  (setq ent (entget (car (entsel))))
  (setq pt1 (cdr (assoc 10 ent)))
  (setq pt2 (cdr (assoc 11 ent)))
  (setq ang (angle pt1 pt2))
  (setq ang (/ (* ang 180.0) pi))
  (setvar "cmdecho" 0)
(command "setvar" "snapang" ang)
(setvar "cmdecho" cmd)
)

(defun C:TG ()
  (initget "Increase New")
  (setq ans (getkword "Increase/<New>: "))
  (modang)
)
(defun modang (/ ang ss ca e na ssl)
(if (= ans "Increase")
   (princ "\nIncrease angle for text by: ")
   (princ "\nNew angle for text: ")
)
(setq ang (getreal))
(setq ang (* (/ ang 180) pi))
(setq ss (ssget))
(setq ca 0 ssl (sslength ss))
(while (< ca ssl)
  (if (= "TEXT" (cdr (assoc 0 (setq e (entget (ssname ss ca))))))
(progn
(if (= ans "Increase")
      (setq na (cons 50 (+ (cdr (assoc 50 e)) ang)))
      (setq na (cons 50 ang))
)
(setq e (subst na (assoc 50 e) e))
(entmod e)
  (setq ca (1+ ca))
)
)
)
(terpri)
)

(defun c:WL ()
  (setvar "cmdecho" 0)
  (setq a 1)
  (prompt "\nSelect Polylines to change: ")
  (while (/= a nil)
(progn
(setq a (entsel))
(if (/= a nil)
      (progn
      (setq b (entget (car a)))
      (setq c (cdr (assoc 40 b)))
      (princ c)
      (command "pedit"a"w""lw""")
      ))))
  (princ)
)

;;; ================================ TEXT FIT ============================

(Defun c:FT ( )
  (defun setsnapang (arg /) (setvar "snapang" (angtof (angtos (cdr (assoc 50 arg)) 0 8) 0 ))  )
  (Defun LL-xyz (arg) (CAR (TextBox arg))  )
  (Defun UR-x (arg) (CAADR (TextBox arg))  )
  (Defun LL-y (arg)    (CADAR (TextBox arg))  )
  (Defun LR-xy (arg)    (List (UR-x arg) (LL-y arg))  )
(Setq ename (CAR (EntSel "\nSelect Text to stretch/shrink:" )  )
   Textent (If ename (EntGet ename)) )
(If (= (CDR (Assoc 0 textent)) "TEXT")
   (Progn (initget 0 "Start")
      (Setq  NewEnd  (Distance  (LR-xy Textent) (LL-xyz Textent) ) )
      (setsnapang Textent)                ;set snap along text entity
      (setvar "ORTHOMODE" 1)                ;drag along the text
      (setq
TMP (getpoint (cdr (assoc 10 Textent)) "\nStarting Point/<Pick new ending point>: ") )
      (setvar "snapang" 0)
      (cond
         ((= (type TMP) 'STR) ;;new starting point to be selected
            (setq Start (getpoint "\nPick new starting point: "))
            (if Start  (progn
               (command "_UCS" "_E" (cdr (assoc -1 textent)))
               (setvar "ORTHOMODE" 1)
               (setq NewPt
                     (if Start
      (getpoint (trans Start 0 1) " ending point: ") nil ) )
               (if NewPt (setq NewPt (trans NewPt 1 0)))
               (setvar "ORTHOMODE" 0)
               (command "_UCS" "_W") ) ) )
         ((not (null TMP)) ;;new ending point selected
            (setq Start (cdr (assoc 10 Textent)) NewPt TMP)  )
         (t  (setq Start nil NewPt nil) ) )
      (if (and Start NewPt) (progn
         (setq Val (Assoc 41 Textent) ;;current width factor
               Val (if Val (cdr Val) 1.0)  LTC_%
      (* (/ (Distance Start NewPt) NewEnd ) Val )
               textent (Subst (cons 41 LTC_%)
         (assoc 41 textent) textent)
  textent (subst (cons 10 Start) (assoc 10 textent) textent)
  textent (subst (cons 11 NewPt) (assoc 11 textent) textent) )
(EntMod textent) (EntUpd (cdr (assoc -1 textent))))))) (Princ))

;=====================================================================
;=========================COPY + ROTATE ==============================
;=====================================================================

(defun c:CR(/ olderr cm loop ss1 ss2 bp mult lent ss2 lp1 lp2)
  (setq olderr *error*
      *error* croerr)
  (setq cm (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq loop t)
  (while (not (setq ss1 (ssget))))
  (initget 1 "Multiple")
  (setq bp (getpoint "\nBase point or displacement>/Multiple: "))
  (if (= bp "Multiple")
(progn
   (setq bp (getpoint "\nBase point: "))
   (setq mult t)
)
  )
  (while loop
(setq loop mult)
(setq lent (lastent))
(command ".copy" ss1 "" bp bp)
(setq ss2 (lss lent))
(setq lp1 (getvar "lastpoint"))
(prompt "\nSecond point of displacement: ")
(command ".move" ss2 "" bp pause)
(setq lp2 (getvar "lastpoint"))
(redss ss1)
(if (and (not mult)
         (= (distance lp1 lp2) 0)
      )
   (setq lp2 (getpoint "\nRotation Point: "))
)
(if mult
   (prompt "\nRotation angle ")
   (prompt "\nReference/<Rotation angle>: ")
)
(command ".rotate" ss2 "" lp2 pause)
  )
  (setvar "CMDECHO" cm)
  (setq *error* olderr)
  (princ)
)
(princ)
(defun croerr (s)
  (if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
  )
  (setq S nil)
  (setvar "CMDECHO" cm)
  (setq *error* olderr)
  (princ)
)
(defun lastent (/ a b)
  (if (setq a (entlast))
(while (setq b (entnext a))
   (setq a b)
)
  )
  a
)
(defun redss (ss / en i)
  (setq i 0)
  (while (setq en (ssname ss i))
(redraw en 1)
(setq i (1+ i))
  )
)
(defun lss (en / sels ed)
  (setq sels (ssadd))
  (while (/= en nil)
(if (setq en (entnext en)) (setq ed (entget en)))
(if (/= en nil) (setq sels (ssadd en sels)))
(if (or (= (cdr (assoc 0 ed)) "Polyline")
         (= (cdr (assoc 0 ed)) "Insert")
      )
   (while (/= (cdr (assoc 0 (entget (setq en (entnext en))))) "Seqend"))
)
  )
  sels
)

;;;; ================== CAC FUNCTIONS DUNG TRONG ACAD.LSP ==================
;;;==================== Tran Ngoc Thang - Sinh 03-05-1976===================

(defun c:00 ()(princ "\nChon doi tuong net Defpoints")(ssget)(command "change" "p" "" "p" "la" "Defpoints" ""))
(defun c:0 ()(princ "\nChon doi tuong net 0")(ssget)(command "change" "p" "" "p" "la" "0" ""))
(defun c:1 ()(princ "\nChon doi tuong net COT")(ssget)(command "change" "p" "" "p" "la" "COT" ""))
(defun c:11 ()(princ "\nChon doi tuong net DIM")(ssget)(command "change" "p" "" "p" "la" "DIM" ""))
(defun c:22 ()(princ "\nChon doi tuong net MANH")(ssget)(command "change" "p" "" "p" "la" "MANH" ""))
(defun c:33 ()(princ "\nChon doi tuong net NETMANH")(ssget)(command "change" "p" "" "p" "la" "NETMANH" ""))
(defun c:2 ()(princ "\nChon doi tuong net NETDUT")(ssget)(command "change" "p" "" "p" "la" "NETDUT" ""))
(defun c:3 ()(princ "\nChon doi tuong net NOITHAT")(ssget)(command "change" "p" "" "p" "la" "NOITHAT" ""))
(defun c:4 ()(princ "\nChon doi tuong net TUONG")(ssget)(command "change" "p" "" "p" "la" "TUONG" ""))
(defun c:44 ()(princ "\nChon doi tuong net KHUNGTEN")(ssget)(command "change" "p" "" "p" "la" "KHUNGTEN" ""))
(defun c:5 ()(princ "\nChon doi tuong net TIMTUONG")(ssget)(command "change" "p" "" "p" "la" "TIMTUONG" ""))
(defun c:6 ()(princ "\nChon doi tuong net CUA")(ssget)(command "change" "p" "" "p" "la" "CUA" ""))
(defun c:77 ()(princ "\nChon doi tuong net THAY")(ssget)(command "change" "p" "" "p" "la" "THAY" ""))
(defun c:7 ()(princ "\nChon doi tuong net NETTHAY")(ssget)(command "change" "p" "" "p" "la" "NETTHAY" ""))
(defun c:8 ()(princ "\nChon doi tuong net HATCH")(ssget)(command "change" "p" "" "p" "la" "HATCH" ""))
(defun c:9 ()(princ "\nChon doi tuong net TEXTTXT")(ssget)(command "change" "p" "" "p" "la" "TEXTTXT" ""))
(defun c:99 ()(princ "\nChon doi tuong net TEXTVN")(ssget)(command "change" "p" "" "p" "la" "TEXTVN" "p" "C" "bylayer" ""))
(defun c:td ()(princ "\nChon doi tuong net THEPDOC")(ssget)(command "change" "p" "" "p" "la" "THEPDOC" ""))
(defun c:ddt ()(princ "\nChon doi tuong net THEPDAI")(ssget)(command "change" "p" "" "p" "la" "THEPDAI" ""))

;=====================================================================
;===================DAT Ti Le Theo KHO GIAY BAN VE====================
;;;=============== Tran Ngoc Thang - Sinh 03-05-1976 =================

;(defun c:SA6 () (Command "DIMSCALE" "111.11111" ))(princ)
;(defun c:SA5 () (Command "DIMSCALE" "1111.1111" ))(princ)
;(defun c:SA4 () (Command "DIMSCALE" "1111.1111" ))(princ)
;(defun c:SA3 () (Command "DIMSCALE" "11111.111" ))(princ)
;(defun c:SA2 () (Command "DIMSCALE" "111111.11" ))(princ)
;(defun c:SA1 () (Command "DIMSCALE" "111111.11" ))(princ)
;(defun c:SA0 () (Command "DIMSCALE" "1111111.1" ))(princ)

;=====================================================================
;===================DAT Ti Le Theo KHO GIAY BAN VE====================
;;;=============== Tran Ngoc Thang - Sinh 03-05-1976 =================

;=============== DAT NET IN de xuat anh JPG [W x H] [5940.00 x 4200.00] =============

;=============== DAT NET IN de xuat anh JPG [W x H] [5940.00 x 4200.00] =============

(alert "Using the NetXuatAnh-[ 5940.00 x 4200.00 <pixels> ] command!")
(princ "\nEnter (DEFUN C:netxuatanh () to get to real LAYER command.\n") (command "NETXUATANH")

;=============== DAT LAYER NET de xuat anh JPG [W x H] [5940.00 x 4200.00] ===DRAW===

;(DEFUN C:netxuatanh ()
                        (COMMAND "-LAYER" "M" "NETDUT" "C" "8" "" "Lw" "0.6" "" "LT" "ACAD_ISO03W100" "" "" "LTSCALE" "5" ""
                           "-LAYER" "M" "TUONG" "C" "4" "" "Lw" "1.58" ""
                                       "M" "MANH" "C" "9" "" "Lw" "0.5" ""
                                    "M" "DIM" "C" "1" "" "Lw" "0.6" ""
                                    "M" "THAY" "C" "7" "" "Lw" "0.7" ""
                                    "M" "NOITHAT" "C" "60" "" "Lw" "0.5" ""
                                    "M" "HATCH" "C" "5" "" "Lw" "0.35" ""
                                    "M" "COT" "C" "2" "" "Lw" "2" ""
                                    "M" "Defpoints" "C" "7" ""
                                    "M" "0" "C" "3" "" "Lw" "0.5" ""
;                                     "M" "1" "C" "1" "" "Lw" "0.5" ""
;                                     "M" "2" "C" "31" "" "Lw" "0.5" ""
;                                     "M" "3" "C" "8" "" "Lw" "0.35" ""
;                                     "M" "4" "C" "4" "" "Lw" "0.8" ""
;                                     "M" "6" "C" "6" "" "Lw" "0.35" ""
;                                     "M" "7" "C" "7" "" "Lw" "0.4" ""
;                                     "M" "8" "C" "8" "" "Lw" "0.35" ""
                                    "M" "DAY-DIEN" "C" "3" "" "Lw" "0.5" ""
                                    "M" "DUONGBAO" "C" "7" "" "Lw" "1" ""
;                                     "M" "KE" "C" "8" "" "Lw" "0.3" ""
;                                     "M" "KT" "C" "9" "" "Lw" "0.35" ""
                                    "M" "NETDAM" "C" "4" "" "Lw" "1" ""
                                    "M" "NETTHAY" "C" "255" "" "Lw" "0.7" ""
                                    "M" "NETMANH" "C" "43" "" "Lw" "0.5" ""
                                    "M" "ThietBiDIEN" "C" "2" "" "Lw" "0.8" ""
                                    "M" "TEXT" "C" "7" "" "Lw" "1.58" ""
                                    "M" "TEXTTXT" "C" "7" "" "Lw" "0.5" ""
                                    "M" "TEXTVN" "C" "60" "" "Lw" "0.4" ""
                                    "M" "TEXTVNi" "C" "60" "" "Lw" "0.4" ""
                                    "M" "THEPDAI" "C" "3" "" "Lw" "0.7" ""
                                    "M" "THEPDOC" "C" "2" "" "Lw" "1.58" ""
                                    "M" "CUA" "C" "6" "" "Lw" "0.5" ""
                                    "M" "CUAMATDUNG" "C" "6" "" "Lw" "0.5" ""

;=============== DAT NET IN de xuat anh JPG [W x H] [5940.00 x 4200.00] ===NUOC===

                                    "M" "10-VAN_KHOA" "C" "10" "" "Lw" "0.5" ""
                                    "M" "4-WateR_IN" "C" "4" "" "Lw" "0.6" "" "LT" "FENCELINE1" ""
                                    "M" "4-WateR_OUT" "C" "4" "" "Lw" "0.6" "" "LT" "FENCELINE2" ""
;                                     "M" "250" "C" "250" "" "Lw" "0.35" ""
                                    "M" "KHUNGTEN" "C" "4" "" "Lw" "1" ""
                                    "M" "TIMTUONG" "C" "5" "" "Lw" "0.5" "" "LT" "ACAD_ISO10W100" "" "" "LTSCALE" "10" )(princ)

;=============== DAT LAYER TEXT de xuat anh JPG [DIM] [TEXT] [GHI CHU]======
;===================================30|04|2024==============================

                  (Command "-style" "VNi-AUCHON" "vauchon.ttf" "225" "1" "0" "n" "n" )(princ)
                  (Command "-style" "VNi-COURI" "vcouri.ttf" "200" "1" "0" "n" "n" )(princ)
                  (Command "-style" "VNi-COURIB" "vcourib.ttf" "200" "1" "0" "n" "n" )(princ)
                  (Command "-style" "Vni-VietNam" "vn_vni,vns.shx" "0" "1" "0" "n" "n" "n" )
                  (Command "-style" "Vni-ROMANS-TEXT" "vni-romans,vns.shx" "200" "1" "0" "n" "n" "n" )
                  (Command "-style" "COTES" "tcvn3italic,vns.shx" "0" "1" "0" "n" "n" "n" )
                  (Command "-style" "TRUC" "impact" "0" "1" "0" "n" "n" )
                  (Command "-style" "VNHELVLT-Hoa" "vnhelvh,vnh.shx" "500" "1""0" "n" "n" )
                  (Command "-style" "VNHELVLT-Thuong" "vnhelv,vnh.shx" "500""1" "0" "n" "n" )
                  (Command "-style" "STANDARD" "Cambria" "250" "1" "0" "n" "n" )
                  (Command "-style" "CAMBRIA" "Cambria" "200" "1" "0" "n" "n" )
                  (Command "-style" "GHIKH" "romant,vns.shx" "0" "1" "0" "n" "n" "n")
                  (Command "-style" "GHISH" "impact" "0" "1" "0" "n" "n" )
                  (Command "-style" "ROMANT-DIM" "abcroman,vns.shx" "0" "1" "0" "n" "n" "n" )
                  (Command "-style" "ROMANC-KhungTEN" "abcroman,vnh.shx" "200" "1" "0" "n" "n" "n" )
                  (Command "-style" "ROMAND-TEXT" "abcrom,vnh.shx" "200" "1" "0" "n" "n" "n")
                  (Command "-style" "ROMANT-TEXT" "tcvn3italic,vnh.shx" "200" "1" "0" "n" "n" "n" )(princ)

;============= DAT NET IN de xuat anh JPG [W x H] [5940.00 x 4200.00] =DIM-STYLE=
;===================================17|10|2024===================================

                  (Command "DIMTXSTY" "ROMANT-DIM" )(princ)
                  (Command "DIMBLK" "Closed" )(princ)

;============= DAT NET IN de xuat anh JPG [W x H] [5940.00 x 4200.00] =DIM-STYLE=
;===================================17|10|2024===================================

;(Command "-units" "2" "8" "1" "8" "" "N")
(Command "-plot" "Y" "" "publishtoweb jpg.pc3" "User 1 (5940.00 x 4200.00 Pixels)" "Landscape" "N" "Display" "Fit" "Center" "Y" "monochrome.ctb" "Y" "" "N" "" "N" )(princ)

;============= DAT NET IN de xuat anh JPG [W x H] [5940.00 x 4200.00] =DIM-STYLE=
;===================================17|10|2024===================================

;======== KET THUC - DAT NET IN de xuat anh JPG [W x H] [5940.00 x 4200.00] =====

;======================== DAT NET IN & TI LE BAN VE =============================

;=================LENH VE KHUNG TEN - Tieu Diet Lenh==================
;=============== DAT KHO GIAY BAN VE - KIEU KHUNG TEN ================
;;;=============== Tran Ngoc Thang - Sinh 03-05-1976 =================
;=============================11|07|2025==============================
;Ti Le Ban Ve - 1 : 100
(Defun c:kta4 ()
      (setq mv_sc 100);Ti le  ban ve
   (setq x4  297)
   (setq y4  210)
  (setq x4 (* mv_sc x4)
      y4 (* mv_sc y4)  )
  (command
"LIMITS" "0,0" (list x4 y4)
"PLINE" "0,0" (list 0 y4) (list x4 y4) (list x4 0) "0,0" "_C"
;Khung CHU NHAT Chinh
"RECTANG" "500,500" "@28700,20000"
"RECTANG" "700,700" "@28300,19600"
;Khung Ten Chung
"RECTANG" "700,700" "@8000,1250"
"RECTANG" "700,700" "@17300,2500"
;Ten Ban Ve
"RECTANG" "18000,700" "@11000,1250"
"RECTANG" "18000,700" "@11000,2500"
;Khung Ti Le + Ngay Thang Nam
"RECTANG" "22500,700" "@2000,2500"
;Khung CHU TRI
"RECTANG" "8700,700" "@3800,2500"
"ZOOM" "_a"  ))
;=====================================================================
;Ti Le Ban Ve - 1 : 100
(Defun c:kt4a ()
      (setq mv_sc 100);Ti le  ban ve
   (setq x4  297)
   (setq y4  210)
  (setq x4 (* mv_sc x4)
      y4 (* mv_sc y4)  )
  (command
"LIMITS" "0,0" (list x4 y4)
"PLINE" "0,0" (list 0 y4) (list x4 y4) (list x4 0) "0,0" "_C"
;Khung CHU NHAT Chinh
"RECTANG" "2000,500" "@27200,20000"
"RECTANG" "2200,700" "@26800,19600"
;Khung Ten Chung
"RECTANG" "2200,700" "@6500,1250"
"RECTANG" "2200,700" "@15800,2500"
;Ten Ban Ve
"RECTANG" "18000,700" "@11000,1250"
"RECTANG" "18000,700" "@11000,2500"
;Khung Ti Le + Ngay Thang Nam
"RECTANG" "22500,700" "@2000,2500"
;Khung CHU TRI
"RECTANG" "8700,700" "@3800,2500"
"ZOOM" "_a"  ))

;=================LENH VE KHUNG TEN - Tieu Diet Lenh==================
;=============== DAT KHO GIAY BAN VE - KIEU KHUNG TEN ================
;;;=============== Tran Ngoc Thang - Sinh 03-05-1976 =================
;=============================04|07|2026==============================
;Ti Le Ban Ve - 1 : 100
(Defun c:za4 ()
      (setq mv_sc 100);Ti le  ban ve
   (setq x4  297)
   (setq y4  210)
  (setq x4 (* mv_sc x4)
      y4 (* mv_sc y4)  )
  (command
"LIMITS" "0,0" (list x4 y4)
"PLINE" "0,0" (list 0 y4) (list x4 y4) (list x4 0) "0,0" "_C"
;Khung CHU NHAT Chinh
"RECTANG" "500,500" "@28700,20000"
"RECTANG" "700,700" "@28300,19600"
;Ten Ban Ve
"RECTANG" "24500,700" "29000,1950"
"RECTANG" "24500,1950" "29000,3200"
;Khung Ti Le + Ngay Thang Nam
"RECTANG" "24500,3200" "26750,4450"
"RECTANG" "26750,3200" "29000,4450"
;Khung Kiem Tra
"RECTANG" "24500,4450" "29000,6325"
;Khung Thiet Ke
"RECTANG" "24500,6325" "29000,8200"
;Khung CHU TRI
"RECTANG" "24500,8200" "29000,10075"
;Khung GIAM DOC
"RECTANG" "24500,10075" "29000,11950"
;Khung HANG MUC
"RECTANG" "24500,11950" "29000,14450"
;Khung CONG TY
"RECTANG" "24500,14450" "29000,16950"
;Khung REPAIRE
"RECTANG" "24500,16950" "29000,18125"
"RECTANG" "24500,18125" "29000,19300"
"RECTANG" "24500,19300" "29000,20300"
"RECTANG" "25500,16950" "25500,20300"
"ZOOM" "_a"  ))
;=====================================================================
;Ti Le Ban Ve - 1 : 100
(Defun c:zb4 ()
      (setq mv_sc 100);Ti le  ban ve
   (setq x4  297)
   (setq y4  210)
  (setq x4 (* mv_sc x4)
      y4 (* mv_sc y4)  )
  (command
"LIMITS" "0,0" (list x4 y4)
"PLINE" "0,0" (list 0 y4) (list x4 y4) (list x4 0) "0,0" "_C"
;Khung CHU NHAT Chinh
"RECTANG" "2000,500" "@27200,20000"
"RECTANG" "2200,700" "@26800,19600"
;Ten Ban Ve
"RECTANG" "24500,700" "29000,1950"
"RECTANG" "24500,1950" "29000,3200"
;Khung Ti Le + Ngay Thang Nam
"RECTANG" "24500,3200" "26750,4450"
"RECTANG" "26750,3200" "29000,4450"
;Khung Kiem Tra
"RECTANG" "24500,4450" "29000,6325"
;Khung Thiet Ke
"RECTANG" "24500,6325" "29000,8200"
;Khung CHU TRI
"RECTANG" "24500,8200" "29000,10075"
;Khung GIAM DOC
"RECTANG" "24500,10075" "29000,11950"
;Khung HANG MUC
"RECTANG" "24500,11950" "29000,14450"
;Khung CONG TY
"RECTANG" "24500,14450" "29000,16950"
;Khung REPAIRE
"RECTANG" "24500,16950" "29000,18125"
"RECTANG" "24500,18125" "29000,19300"
"RECTANG" "24500,19300" "29000,20300"
"RECTANG" "25500,16950" "25500,20300"
"ZOOM" "_a"  ))

;;; ============================GHI CHU Khung Ten========================
;;; ======== Phai Vao STYLE Tao LAYER Ten TEXT + Phai Dat Height ========
;;;=============== Tran Ngoc Thang - Sinh 03-05-1976 ====================
;;; =======================Thuong Dung Font Romant.vnh===================

(defun c:GhiChu (/ pta ptb ptc ptd X Y X1 Y1 rmsz pl1)
  (setq oer *error* *error* err2)
  (PROMPT "\nChuTri. ThietKe. KiemTra. TiLe. Ngay. HangMuc. QuyMo. KieuNha. CongTrinh. KyHieu. TenBanVe. Kts. TranNgocThang. ")
  (SETQ Cpt(GETSTRING "\n(CT). (TK). (KT). (TL). (Ng). (HM). (QM). (KN). (CTr). (KH). (TBV). (Kts). (TnT). "))
  (IF(OR(= Cpt "QM")(= cpt "qm"))(SETQ CPT ' "Hå S¬ ThiÕt KÕ Nhµ D©n Dông quy M« :"))
  (IF(OR(= cpt "KN")(= cpt "kn"))(SETQ CPT ' "2 TÇng 1 Tum Thang"))
  (IF(OR(= cpt "CT")(= cpt "ct"))(SETQ CPT ' "Chñ Tr× :"))
  (IF(OR(= cpt "HM")(= cpt "hm"))(SETQ CPT ' "H¹ng Môc :"))
  (IF(OR(= cpt "CTr")(= cpt "ctr"))(SETQ CPT ' "Nhµ ë Gia §×nh - Nhµ LiÒn KÒ"))
  (IF(OR(= cpt "TK")(= cpt "tk"))(SETQ CPT ' "ThiÕt KÕ :"))
  (IF(OR(= cpt "KT")(= cpt "kt"))(SETQ CPT ' "KiÓm Tra :"))
  (IF(OR(= cpt "TL")(= cpt "tl"))(SETQ CPT ' "TØ LÖ :"))
  (IF(OR(= cpt "KH")(= cpt "kh"))(SETQ CPT ' "Ký HiÖu :"))
  (IF(OR(= cpt "TBV")(= cpt "tbv"))(SETQ CPT ' "Tªn B¶n VÏ :"))
  (IF(OR(= cpt "Ng")(= cpt "ng"))(SETQ CPT ' "Ngµy :"))
  (IF(OR(= cpt "Kts")(= cpt "kts"))(SETQ CPT ' "Kts. TrÇn Ngäc Th¾ng"))
  (IF(OR(= cpt "TnT")(= cpt "tnt"))(SETQ CPT ' "TrÇn Ngäc Th¾ng"))
(setq pta (getpoint
"\nPick first corner. : "))
  (setq ptb (getcorner pta
"\nPick second corner. : "))
  (setq ptc (list (car ptb)(cadr pta)))
  (setq ptd (list (car pta)(cadr ptb)))
  (setq ang (angle pta ptb))
  (setq d1 (/(distance pta ptb) 2))
  (setq cp (polar pta (- ang (dtr 0)) d1))
  (setq X (distance pta ptc))
  (setq Y (distance pta ptd))
  (setq X1 (rtos x 2 1))
  (setq Y1 (rtos y 2 1))
  (setq rmsz (strcat "(" X1 " x " Y1 ")"))
  (command "TEXT" "c" cp "0" CPT "text" "" rmsz))
  (defun dtr (angg)
  (* pi (/ angg 180.0)))

;;; ============================GHI CHU Khung Ten========================
;;; ======== Phai Vao STYLE Tao LAYER Ten TEXT + Phai Dat Height ========
;;;=============== Tran Ngoc Thang - Sinh 03-05-1976 ====================
;;; =======================Thuong Dung Font Romant.vnh===================

(defun c:iit (/ pt str pta ptb ptc ptd X Y X1 Y1 rmsz pl1)
  (setq oer *error* *error* err2)
  (if (not h_text) (setq h_text 250)) ; Kích thuoc chu mac dinh là 2.5

  (setq ht (getreal (strcat "\nNhap chieu cao chu <" (rtos h_text) ">: ")))

  (if ht (setq h_text ht))

(setq ang (getreal "\nNhap goc nghieng moi (do) <0>: "))

   (if (not ang) (setq ang 0.0))

(setq pta (getpoint
"\nPick first corner. : "))
  (setq pt (getcorner pta
"\nPick second corner. : "))

  (command "TEXT" "j" "M" "4700,2575" "0" (SETQ pt ' "Hå S¬ ThiÕt KÕ Nhµ D©n Dông Quy M«") ) (princ)

  (command "TEXT" "j" "M" "4700,1325" "0" (SETQ pt ' "2 TÇng 1 Tum Thang") ) (princ)

  (command "TEXT" "j" "M" "10600,2850" "0" (SETQ pt ' "Chñ Tr× :") ) (princ)

  (command "TEXT" "j" "M" "10600,1100" "0" (SETQ pt '  "TrÇn Ngäc Th¾ng") ) (princ)

  (command "TEXT" "j" "M" "15250,2575" "0" (SETQ pt ' "H¹ng Môc :") ) (princ)

  (command "TEXT" "j" "M" "15250,1950" "0" (SETQ pt ' "Nhµ ë Gia §×nh . Nhµ LiÒn KÒ") ) (princ)

  (command "TEXT" "j" "M" "15250,1100" "0" (SETQ pt ' "Tel : 09.76.89.12.94") ) (princ)

  (command "TEXT" "j" "M" "20250,2850" "0" (SETQ pt ' "ThiÕt KÕ :") ) (princ)

  (command "TEXT" "j" "M" "20250,2300" "0" (SETQ pt ' "Kts. TrÇn Ngäc Th¾ng") ) (princ)

  (command "TEXT" "j" "M" "20250,1600" "0" (SETQ pt ' "KiÓm Tra :") ) (princ)

  (command "TEXT" "j" "M" "20250,1100" "0" (SETQ pt ' "Kts. TrÇn Ngäc Th¾ng") ) (princ)

  (command "TEXT" "j" "M" "23500,2850" "0" (SETQ pt ' "TØ LÖ :") ) (princ)

  (command "TEXT" "j" "M" "23500,2300" "0" (SETQ pt ' "1:75") ) (princ)

  (command "TEXT" "j" "M" "23500,1600" "0" (SETQ pt ' "Ngµy :") ) (princ)

  (command "TEXT" "j" "M" "23500,1100" "0" (SETQ pt ' "2026.07.02") ) (princ)

  (command "TEXT" "j" "M" "26750,2850" "0" (SETQ pt ' "Tªn B¶n VÏ :") ) (princ)

  (command "TEXT" "j" "M" "26750,2300" "0" (SETQ pt ' "MÆt B»ng TÇng 1 + 2") ) (princ)

  (command "TEXT" "j" "M" "26750,1600" "0" (SETQ pt ' "Ký HiÖu :") ) (princ)

  (command "TEXT" "j" "M" "26750,1100" "0" (SETQ pt ' "KT-01") ) (princ)

  (setq ptc (list (car ptb)(cadr pta)))
  (setq ptd (list (car pta)(cadr ptb)))
  (setq ang (angle pta ptb))
  (setq d1 (/(distance pta ptb) 2))
  (setq cp (polar pta (- ang (dtr 0)) d1))
  (setq X (distance pta ptc))
  (setq Y (distance pta ptd))
  (setq X1 (rtos x 2 1))
  (setq Y1 (rtos y 2 1))
  (setq rmsz (strcat "(" X1 " x " Y1 ")"))
  (command "TEXT" "c" cp "0" CPT "_text" "" rmsz))
  (defun dtr (angg)
  (* pi (/ angg 180.0)))

;;; ============================GHI CHU Khung Ten========================
;;; ======== Phai Vao STYLE Tao LAYER Ten TEXT + Phai Dat Height ========
;;;=============== Tran Ngoc Thang - Sinh 03-05-1976 ====================
;;; =======================Thuong Dung Font Romant.vnh===================

(defun c:ipt (/ pt str pta ptb ptc ptd X Y X1 Y1 rmsz pl1)
  (setq oer *error* *error* err2)
  (if (not h_text) (setq h_text 250)) ; Kích thuoc chu mac dinh là 2.5

  (setq ht (getreal (strcat "\nNhap chieu cao chu <" (rtos h_text) ">: ")))

  (if ht (setq h_text ht))

(setq ang (getreal "\nNhap goc nghieng moi (do) <0>: "))

   (if (not ang) (setq ang 0.0))

(setq pta (getpoint
"\nPick first corner. : "))
  (setq pt (getcorner pta
"\nPick second corner. : "))

  (command "TEXT" "j" "M" "5450,2575" "0" (SETQ pt ' "Hå S¬ ThiÕt KÕ Nhµ D©n Dông Quy M«") ) (princ)

  (command "TEXT" "j" "M" "5450,1325" "0" (SETQ pt ' "2 TÇng 1 Tum Thang") ) (princ)

  (command "TEXT" "j" "M" "10600,2850" "0" (SETQ pt ' "Chñ Tr× :") ) (princ)

  (command "TEXT" "j" "M" "10600,1100" "0" (SETQ pt '  "TrÇn Ngäc Th¾ng") ) (princ)

  (command "TEXT" "j" "M" "15250,2575" "0" (SETQ pt ' "H¹ng Môc :") ) (princ)

  (command "TEXT" "j" "M" "15250,1950" "0" (SETQ pt ' "Nhµ ë Gia §×nh . Nhµ LiÒn KÒ") ) (princ)

  (command "TEXT" "j" "M" "15250,1100" "0" (SETQ pt ' "Tel : 09.76.89.12.94") ) (princ)

  (command "TEXT" "j" "M" "20250,2850" "0" (SETQ pt ' "ThiÕt KÕ :") ) (princ)

  (command "TEXT" "j" "M" "20250,2300" "0" (SETQ pt ' "Kts. TrÇn Ngäc Th¾ng") ) (princ)

  (command "TEXT" "j" "M" "20250,1600" "0" (SETQ pt ' "KiÓm Tra :") ) (princ)

  (command "TEXT" "j" "M" "20250,1100" "0" (SETQ pt ' "Kts. TrÇn Ngäc Th¾ng") ) (princ)

  (command "TEXT" "j" "M" "23500,2850" "0" (SETQ pt ' "TØ LÖ :") ) (princ)

  (command "TEXT" "j" "M" "23500,2300" "0" (SETQ pt ' "1:75") ) (princ)

  (command "TEXT" "j" "M" "23500,1600" "0" (SETQ pt ' "Ngµy :") ) (princ)

  (command "TEXT" "j" "M" "23500,1100" "0" (SETQ pt ' "2026.07.02") ) (princ)

  (command "TEXT" "j" "M" "26750,2850" "0" (SETQ pt ' "Tªn B¶n VÏ :") ) (princ)

  (command "TEXT" "j" "M" "26750,2300" "0" (SETQ pt ' "MÆt B»ng TÇng 1 + 2") ) (princ)

  (command "TEXT" "j" "M" "26750,1600" "0" (SETQ pt ' "Ký HiÖu :") ) (princ)

  (command "TEXT" "j" "M" "26750,1100" "0" (SETQ pt ' "KT-01") ) (princ)

  (setq ptc (list (car ptb)(cadr pta)))
  (setq ptd (list (car pta)(cadr ptb)))
  (setq ang (angle pta ptb))
  (setq d1 (/(distance pta ptb) 2))
  (setq cp (polar pta (- ang (dtr 0)) d1))
  (setq X (distance pta ptc))
  (setq Y (distance pta ptd))
  (setq X1 (rtos x 2 1))
  (setq Y1 (rtos y 2 1))
  (setq rmsz (strcat "(" X1 " x " Y1 ")"))
  (command "TEXT" "c" cp "0" CPT "_text" "" rmsz))
  (defun dtr (angg)
  (* pi (/ angg 180.0)))

;;; ============================GHI CHU Khung Ten========================
;;; ======== Phai Vao STYLE Tao LAYER Ten TEXT + Phai Dat Height ========
;;;=============== Tran Ngoc Thang - Sinh 03-05-1976 ====================
;;; =======================Thuong Dung Font Romant.vnh===================

(defun c:iza (/ pt str pta ptb ptc ptd X Y X1 Y1 rmsz pl1)
  (setq oer *error* *error* err2)
  (if (not h_text) (setq h_text 250)) ; Kích thuoc chu mac dinh là 2.5

  (setq ht (getreal (strcat "\nNhap chieu cao chu <" (rtos h_text) ">: ")))

  (if ht (setq h_text ht))

(setq ang (getreal "\nNhap goc nghieng moi (do) <0>: "))

   (if (not ang) (setq ang 0.0))

(setq pta (getpoint
"\nPick first corner. : "))
  (setq pt (getcorner pta
"\nPick second corner. : "))

  (command "TEXT" "j" "M" "25000,19800" "0" (SETQ pt ' "STT") ) (princ)

  (command "TEXT" "j" "M" "25000,18712.5" "0" (SETQ pt ' "1") ) (princ)

  (command "TEXT" "j" "M" "25000,17537.5" "0" (SETQ pt ' "2") ) (princ)

  (command "TEXT" "j" "M" "27250,19800" "0" (SETQ pt ' "Ngµy Söa Hå S¬") ) (princ)

  (command "TEXT" "j" "M" "27250,18712.5" "0" (SETQ pt ' "15.05.1997") ) (princ)

  (command "TEXT" "j" "M" "27250,17537.5" "0" (SETQ pt ' "04.07.2026") ) (princ)

  (command "TEXT" "j" "M" "26750,16600" "0" (SETQ pt ' "C¤NG TY - Corporation") ) (princ)

  (command "TEXT" "j" "M" "26750,16016" "0" (SETQ pt ' "ZENNI.S.Z.T.K") ) (princ)

  (command "TEXT" "j" "M" "26750,15433" "0" (SETQ pt ' "§Þa ChØ C¤NG TY") ) (princ)

  (command "TEXT" "j" "M" "26750,14850" "0" (SETQ pt ' "§Þa ChØ : 00.00.00.00.00") ) (princ)

  (command "TEXT" "j" "M" "26750,14100" "0" (SETQ pt ' "H¹ng Môc : Part Project") ) (princ)

  (command "TEXT" "j" "M" "26750,13516" "0" (SETQ pt ' "Nhµ ë Gia §×nh") ) (princ)

  (command "TEXT" "j" "M" "26750,12933" "0" (SETQ pt '  "Nhµ LiÒn KÒ") ) (princ)

  (command "TEXT" "j" "M" "26750,12350" "0" (SETQ pt ' "Tel : 00.00.00.00.00") ) (princ)

  (command "TEXT" "j" "M" "26750,11600" "0" (SETQ pt ' "Gi¸m §èc : Director") ) (princ)

  (command "TEXT" "j" "M" "26750,10475" "0" (SETQ pt ' "ZENNI.S.Z.T.K") ) (princ)

  (command "TEXT" "j" "M" "26750,9725" "0" (SETQ pt ' "Chñ Tr× : Main Project") ) (princ)

  (command "TEXT" "j" "M" "26750,8600" "0" (SETQ pt '  "Kts. TrÇn Ngäc Th¾ng") ) (princ)

  (command "TEXT" "j" "M" "26750,7850" "0" (SETQ pt ' "ThiÕt KÕ Vµ VÏ : Design") ) (princ)

  (command "TEXT" "j" "M" "26750,6725" "0" (SETQ pt ' "Kts. TrÇn Ngäc Th¾ng") ) (princ)

  (command "TEXT" "j" "M" "26750,5975" "0" (SETQ pt ' "KiÓm Tra : Checking") ) (princ)

  (command "TEXT" "j" "M" "26750,4850" "0" (SETQ pt ' "Kts. TrÇn Ngäc Th¾ng") ) (princ)

  (command "TEXT" "j" "M" "25625,4100" "0" (SETQ pt ' "TØ LÖ-Khæ") ) (princ)

  (command "TEXT" "j" "M" "25625,3600" "0" (SETQ pt ' "1:75 - A4") ) (princ)

  (command "TEXT" "j" "M" "27875,4100" "0" (SETQ pt ' "Ngµy Xong :") ) (princ)

  (command "TEXT" "j" "M" "27875,3600" "0" (SETQ pt ' "2026.07.04") ) (princ)

  (command "TEXT" "j" "M" "26750,2850" "0" (SETQ pt ' "Tªn B¶n VÏ :") ) (princ)

  (command "TEXT" "j" "M" "26750,2300" "0" (SETQ pt ' "MÆt B»ng TÇng 1 + 2") ) (princ)

  (command "TEXT" "j" "M" "26750,1600" "0" (SETQ pt ' "Ký HiÖu :") ) (princ)

  (command "TEXT" "j" "M" "26750,1100" "0" (SETQ pt ' "KT-01") ) (princ)

  (setq ptc (list (car ptb)(cadr pta)))
  (setq ptd (list (car pta)(cadr ptb)))
  (setq ang (angle pta ptb))
  (setq d1 (/(distance pta ptb) 2))
  (setq cp (polar pta (- ang (dtr 0)) d1))
  (setq X (distance pta ptc))
  (setq Y (distance pta ptd))
  (setq X1 (rtos x 2 1))
  (setq Y1 (rtos y 2 1))
  (setq rmsz (strcat "(" X1 " x " Y1 ")"))
  (command "TEXT" "c" cp "0" CPT "_text" "" rmsz))
  (defun dtr (angg)
  (* pi (/ angg 180.0)))

;;; ======== Phai Vao STYLE Tao LAYER Ten TEXT + Phai Dat Height ========
;;;=============== Tran Ngoc Thang - Sinh 03-05-1976 ====================
;;; =======================Thuong Dung Font Romant.vnh===================

(defun c:pta4 (/ pt str pta ptb ptc ptd X Y X1 Y1 rmsz pl1)
  (setq oer *error* *error* err2)
  (if (not h_text) (setq h_text 250)) ; Kích thuoc chu mac dinh là 2.5

  (setq ht (getreal (strcat "\nNhap chieu cao chu <" (rtos h_text) ">: ")))

  (if ht (setq h_text ht))

(setq ang (getreal "\nNhap goc nghieng moi (do) <0>: "))

   (if (not ang) (setq ang 0.0))

(setq pta (getpoint
"\nPick first corner. : "))
  (setq pt (getcorner pta
"\nPick second corner. : "))

  (command "POINT" "4700,2575" ) (princ)

  (command "POINT" "4700,1325" ) (princ)

  (command "POINT" "10600,2850" ) (princ)

  (command "POINT" "10600,1100" ) (princ)

  (command "POINT" "15250,2575" ) (princ)

  (command "POINT" "15250,1950" ) (princ)

  (command "POINT" "15250,1100" ) (princ)

  (command "POINT" "20250,2850" ) (princ)

  (command "POINT" "20250,2300" ) (princ)

  (command "POINT" "20250,1600" ) (princ)

  (command "POINT" "20250,1100" ) (princ)

  (command "POINT" "23500,2850" ) (princ)

  (command "POINT" "23500,2300" ) (princ)

  (command "POINT" "23500,1600" ) (princ)

  (command "POINT" "23500,1100" ) (princ)

  (command "POINT" "26750,2850" ) (princ)

  (command "POINT" "26750,2300" ) (princ)

  (command "POINT" "26750,1600" ) (princ)

  (command "POINT" "26750,1100" ) (princ)

  (setq ptc (list (car ptb)(cadr pta)))
  (setq ptd (list (car pta)(cadr ptb)))
  (setq ang (angle pta ptb))
  (setq d1 (/(distance pta ptb) 2))
  (setq cp (polar pta (- ang (dtr 0)) d1))
  (setq X (distance pta ptc))
  (setq Y (distance pta ptd))
  (setq X1 (rtos x 2 1))
  (setq Y1 (rtos y 2 1))
  (setq rmsz (strcat "(" X1 " x " Y1 ")"))
  (command "TEXT" "c" cp "0" CPT "_text" "" rmsz))
  (defun dtr (angg)
  (* pi (/ angg 180.0)))

;=====================================================================
;====================DAT KHO GIAY BAN VE - KIEU 1=====================
;;;=============== Tran Ngoc Thang - Sinh 03-05-1976 =================

(Defun c:a6 ()
      (setq mv_sc 100);Ti le  ban ve
   (setq x4  74.25)
   (setq y4  52.5)
  (setq x4 (* mv_sc x4)
      y4 (* mv_sc y4)  )
  (command
"LIMITS" "0,0" (list x4 y4)
"PLINE" "0,0" (list 0 y4) (list x4 y4) (list x4 0) "0,0" "_C"
"RECTANG" "125,125" "@7175,5000"
"RECTANG" "175,175" "@7075,4900"
"ZOOM" "_a"  ))
;=====================================================================
(Defun c:a5 ()
      (setq mv_sc 100);Ti le  ban ve
   (setq x4  147.5)
   (setq y4  104)
  (setq x4 (* mv_sc x4)
      y4 (* mv_sc y4)  )
  (command
"LIMITS" "0,0" (list x4 y4)
"PLINE" "0,0" (list 0 y4) (list x4 y4) (list x4 0) "0,0" "_C"
"RECTANG" "250,250" "@14350,10000"
"RECTANG" "350,350" "@14150,9800"
"ZOOM" "_a"  ))
;=====================================================================
(Defun c:a4 ()
      (setq mv_sc 100);Ti le  ban ve
   (setq x4  297)
   (setq y4  210)
  (setq x4 (* mv_sc x4)
      y4 (* mv_sc y4)  )
  (command
"LIMITS" "0,0" (list x4 y4)
"PLINE" "0,0" (list 0 y4) (list x4 y4) (list x4 0) "0,0" "_C"
"RECTANG" "500,500" "@28700,20000"
"RECTANG" "700,700" "@28300,19600"
"ZOOM" "_a"  ))
;=====================================================================
(Defun c:a3 ()
      (setq mv_sc 100)
   (setq x3  420)
   (setq y3  297)
  (setq x3 (* mv_sc x3)
      y3 (* mv_sc y3)  )
  (command
"LIMITS" "0,0" (list x3 y3)
"PLINE" "0,0" (list 0 y3) (list x3 y3) (list x3 0) "0,0" "_C"
"RECTANG" "707.14285714,707.14285714" "@40590,28285.71428571"
"RECTANG" "990,990" "@40024.28571429,27720"
"ZOOM" "_a"  ))
;=====================================================================
(Defun c:a2 ()
      (setq mv_sc 100)
   (setq x2  594)
   (setq y2  420)
  (setq x2 (* mv_sc x2)
      y2 (* mv_sc y2)  )
  (command
"LIMITS" "0,0" (list x2 y2)
"PLINE" "0,0" (list 0 y2) (list x2 y2) (list x2 0) "0,0" "_C"
"RECTANG" "1000,1000" "@57400,40000"
"RECTANG" "1400,1400" "@56600,39200"
"ZOOM" "_a"  ))
;=====================================================================
(Defun c:a1 ()
      (setq mv_sc 100)
   (setq x1  840)
   (setq y1  594)
  (setq x1 (* mv_sc x1)
      y1 (* mv_sc y1)  )
  (command
"LIMITS" "0,0" (list x1 y1)
"PLINE" "0,0" (list 0 y1) (list x1 y1) (list x1 0) "0,0" "_C"
"RECTANG" "1414.28571429,1414.28571429" "@81180,56571.42857143"
"RECTANG" "1980,1980" "@80048.57142857,55440"
"ZOOM" "_a"  ))
;=====================================================================
(Defun c:a0 ()
      (setq mv_sc 100)
   (setq x0  1188)
   (setq y0  840)
  (setq x0 (* mv_sc x0)
      y0 (* mv_sc y0)  )
  (command
"LIMITS" "0,0" (list x0 y0)
"PLINE" "0,0" (list 0 y0) (list x0 y0) (list x0 0) "0,0" "_C"
"RECTANG" "2000,2000" "@114800,80000"
"RECTANG" "2800,2800" "@113200,78400"
"ZOOM" "_a"  ))

;=====================================================================
;====================DAT KHO GIAY BAN VE - KIEU 2=====================
;;;=============== Tran Ngoc Thang - Sinh 03-05-1976 =================

(Defun c:6a ()
      (setq mv_sc 100);Ti le  ban ve
   (setq x4  74.25)
   (setq y4  52.5)
  (setq x4 (* mv_sc x4)
      y4 (* mv_sc y4)  )
  (command
"LIMITS" "0,0" (list x4 y4)
"PLINE" "0,0" (list 0 y4) (list x4 y4) (list x4 0) "0,0" "_C"
"RECTANG" "505,125" "@6800,5000"
"RECTANG" "555,175" "@6700,4900"
"ZOOM" "_a"  ))
;=====================================================================
(Defun c:5a ()
      (setq mv_sc 100);Ti le  ban ve
   (setq x4  148.5)
   (setq y4  105)
  (setq x4 (* mv_sc x4)
      y4 (* mv_sc y4)  )
  (command
"LIMITS" "0,0" (list x4 y4)
"PLINE" "0,0" (list 0 y4) (list x4 y4) (list x4 0) "0,0" "_C"
"RECTANG" "1000,250" "@13600,10000"
"RECTANG" "1100,350" "@13400,9800"
"ZOOM" "_a"  ))
;=====================================================================
(Defun c:4a ()
      (setq mv_sc 100);Ti le  ban ve
   (setq x4  297)
   (setq y4  210)
  (setq x4 (* mv_sc x4)
      y4 (* mv_sc y4)  )
  (command
"LIMITS" "0,0" (list x4 y4)
"PLINE" "0,0" (list 0 y4) (list x4 y4) (list x4 0) "0,0" "_C"
"RECTANG" "2000,500" "@27200,20000"
"RECTANG" "2200,700" "@26800,19600"
"ZOOM" "_a"  ))
;=====================================================================
(Defun c:3a ()
      (setq mv_sc 100)
   (setq x3  420.0428571429)
   (setq y3  297)
  (setq x3 (* mv_sc x3)
      y3 (* mv_sc y3)  )
  (command
"LIMITS" "0,0" (list x3 y3)
"PLINE" "0,0" (list 0 y3) (list x3 y3) (list x3 0) "0,0" "_C"
"RECTANG" "2828.57142857,707.14285714" "@38468.57142857,28285.71428571"
"RECTANG" "3111.42857142,989.99999999" "@37902.85714287,27720.00000001"
"ZOOM" "_a"  ))
;=====================================================================
(Defun c:2a ()
      (setq mv_sc 100)
   (setq x2  594)
   (setq y2  420)
  (setq x2 (* mv_sc x2)
      y2 (* mv_sc y2)  )
  (command
"LIMITS" "0,0" (list x2 y2)
"PLINE" "0,0" (list 0 y2) (list x2 y2) (list x2 0) "0,0" "_C"
"RECTANG" "4000,1000" "@54400,40000"
"RECTANG" "4400,1400" "@53600,39200"
"ZOOM" "_a"  ))
;=====================================================================
(Defun c:1a ()
      (setq mv_sc 100)
   (setq x1  840.0857142857)
   (setq y1  594)
  (setq x1 (* mv_sc x1)
      y1 (* mv_sc y1)  )
  (command
"LIMITS" "0,0" (list x1 y1)
"PLINE" "0,0" (list 0 y1) (list x1 y1) (list x1 0) "0,0" "_C"
"RECTANG" "5657.14285714,1414.28571429" "@76937.14285714,56571.428571436"
"RECTANG" "6222.85714286,1980.00000001" "@75805.71428570,55440"
"ZOOM" "_a"  ))
;=====================================================================
(Defun c:0a ()
      (setq mv_sc 100)
   (setq x0  1188)
   (setq y0  840)
  (setq x0 (* mv_sc x0)
      y0 (* mv_sc y0)  )
  (command
"LIMITS" "0,0" (list x0 y0)
"PLINE" "0,0" (list 0 y0) (list x0 y0) (list x0 0) "0,0" "_C"
"RECTANG" "8000,2000" "@108800,80000"
"RECTANG" "8800,2800" "@107200,78400"
"ZOOM" "_a"  ))

;=====================================================================
;==================DAT KhoGiay Theo KHO GIAY BAN VE===================
;=========================== Nguoi Khac ==============================
(defun c:khogiay (/ oldlst a b c d e f g h kho TL)
(command "undo" "be")
(setq oldlst (mapcar 'getvar (list "CMDECHO" "OSMODE" "cecolor")))
(setvar "CMDECHO" 0)
(setq a (getpoint "\n chon diem chen :"))
(if (not TL) (setq TL 1.00))
(setq TL1 (getDIST (strcat "\nScale <" (rtos TL 2 2) ">:")))
(if TL1 (setq TL TL1))
(setvar "osmode" 0)
(if (not (tblsearch "layer" "Defpoints")) (Command "layer" "N" "Defpoints" ""))
(initget "0 1 2 3 4")
   (setq kho (getkword "\Kho A0 _ Kho A1 _ Kho A2 _ Kho A3 _ Kho A4 [0/1/2/3/4]? <0>:"))
(if (= kho "0")
   (progn
         (setq b (polar a 0 (* TL 1189)))
                  (setq c (polar b (/ pi 2) (* TL 841)))
                  (setq d (polar a (/ pi 2) (* TL 841)))
         (setq e (polar a (/ pi 4) (* TL (sqrt (* 2 12 12)))))
                  (setq f (polar e 0 (- (* TL 1189) (* TL 24))))
                  (setq g (polar f (/ pi 2) (- (* TL 841) (* TL 24))))
                  (setq h (polar e (/ pi 2) (- (* TL 841) (* TL 24))))
  (command "Pline" e f g h "c")
(command "change" "last" "" "properties" "layer" "0" "")
(setvar "cecolor" "4")
  (command "Pline" a b c d "c")
(command "change" "last" "" "properties" "layer" "defpoints" "")))
(if (= kho "1")
   (progn
         (setq b (polar a 0 (* TL 841)))
                  (setq c (polar b (/ pi 2) (* TL 594)))
                  (setq d (polar a (/ pi 2) (* TL 594)))
         (setq e (polar a (/ pi 4) (* TL (sqrt (* 2 12 12)))))
                  (setq f (polar e 0 (- (* TL 841) (* TL 24))))
                  (setq g (polar f (/ pi 2) (- (* TL 594) (* TL 24))))
                  (setq h (polar e (/ pi 2) (- (* TL 594) (* TL 24))))
  (command "Pline" e f g h "c")
(command "change" "last" "" "properties" "layer" "0" "")
(setvar "cecolor" "4")
  (command "Pline" a b c d "c")
(command "change" "last" "" "properties" "layer" "defpoints" "")))
(if (= kho "2")
   (progn
         (setq b (polar a 0 (* TL 594)))
                  (setq c (polar b (/ pi 2) (* TL 420)))
                  (setq d (polar a (/ pi 2) (* TL 420)))
         (setq e (polar a (/ pi 4) (* TL (sqrt (* 2 100)))))
                  (setq f (polar e 0 (- (* TL 594) (* TL 20))))
                  (setq g (polar f (/ pi 2) (- (* TL 420) (* TL 20))))
                  (setq h (polar e (/ pi 2) (- (* TL 420) (* TL 20))))
  (command "Pline" e f g h "c")
(command "change" "last" "" "properties" "layer" "0" "")
(setvar "cecolor" "4")
  (command "Pline" a b c d "c")
(command "change" "last" "" "properties" "layer" "defpoints" "")))
(if (= kho "3")
   (progn
         (setq b (polar a 0 (* tl 420)))
                  (setq c (polar b (/ pi 2) (* TL 297)))
                  (setq d (polar a (/ pi 2) (* TL 297)))
         (setq e (polar a (/ pi 4) (* TL (sqrt (* 2 100)))))
                  (setq f (polar e 0 (- (* TL 420) (* TL 20))))
                  (setq g (polar f (/ pi 2) (- (* TL 297) (* TL 20))))
                  (setq h (polar e (/ pi 2) (- (* TL 297) (* TL 20))))
(command "Pline" e f g h "c")
  (command "change" "last" "" "properties" "layer" "0" "")
(setvar "cecolor" "4")
(command "Pline" a b c d "c")
  (command "change" "last" "" "properties" "layer" "defpoints" "")))
(if (= kho "4")
   (progn
         (setq b (polar a 0 (* TL 297)))
            (setq c (polar b (/ pi 2) (* TL 210)))
                  (setq d (polar a (/ pi 2) (* TL 210)))
         (setq e (polar a (/ pi 4) (* TL (sqrt (* 2 81)))))
                  (setq f (polar e 0 (- (* TL 297) (* TL 18))))
                  (setq g (polar f (/ pi 2) (- (* TL 210) (* TL 18))))
                  (setq h (polar e (/ pi 2) (- (* TL 210) (* TL 18))))
  (command "Pline" e f g h "c")
(command "change" "last" "" "properties" "layer" "0" "")
(setvar "cecolor" "4")
  (command "Pline" a b c d "c")
(command "change" "last" "" "properties" "layer" "defpoints" "")))
(mapcar 'setvar (list "CMDECHO" "OSMODE" "cecolor") oldlst)
(command "undo" "e")
(princ))
;=====================================================================
;==================DAT KhoGiay Theo KHO GIAY BAN VE===================
;=====================================================================

;=====================================================================
;===================DAT Ti Le Theo KHO GIAY BAN VE====================
;;;=============== Tran Ngoc Thang - Sinh 03-05-1976 =================

(DEFUN C:SA6 () (setvar "DIMSCALE" 411.11111)
                  (COMMAND "-LAYER" "M" "NETDUT" "C" "8" "" "Lw" "0.1" "" "LT" "ACAD_ISO03W100" "" "" "LTSCALE" "5" ""
                           "-LAYER" "M" "TUONG" "C" "4" "" "Lw" "0.3" ""
                                       "M" "MANH" "C" "9" "" "Lw" "0.1" ""
                                    "M" "TEXT" "C" "7" "" "Lw" "0.12" ""
                                    "M" "DIM" "C" "1" "" "Lw" "0.12" ""
                                    "M" "THAY" "C" "7" "" "Lw" "0.2" ""
                                    "M" "NOITHAT" "C" "60" "" "Lw" "0.12" ""
                                    "M" "HATCH" "C" "5" "" "Lw" "0.1" ""
                                    "M" "COT" "C" "1" "" "Lw" "0.3" ""
                                    "M" "Defpoints" "C" "7" ""
                                    "M" "0" "C" "3" "" "Lw" "0.12" ""
                                    "M" "CUA" "C" "6" "" "Lw" "0.12" ""
                                    "M" "CUA MATDUNG" "C" "6" "" "Lw" "0.12" ""
                                    "M" "DAY-DIEN" "C" "3" "" "Lw" "0.3" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETDAM" "C" "4" "" "Lw" "0.3" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETTHAY" "C" "255" "" "Lw" "0.5" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETMANH" "C" "43" "" "Lw" "0.3" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "ThietBiDIEN" "C" "2" "" "Lw" "0.6" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTTXT" "C" "7" "" "Lw" "0.3" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTVN" "C" "60" "" "Lw" "0.3" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTVNi" "C" "60" "" "Lw" "0.3" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "THEPDAI" "C" "3" "" "Lw" "0.5" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "THEPDOC" "C" "2" "" "Lw" "1.20" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "10-VAN_KHOA" "C" "10" "" "Lw" "0.3" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "4-WateR_IN" "C" "4" "" "Lw" "0.4" "" "LT" "FENCELINE1" "" "" "LTSCALE" "2"
                                    "M" "4-WateR_OUT" "C" "4" "" "Lw" "0.4" "" "LT" "FENCELINE2" "" "" "LTSCALE" "2"
                                    "M" "KHUNGTEN" "C" "4" "" "Lw" "0.7" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TIMTUONG" "C" "5" "" "Lw" "0.1" "" "LT" "ACAD_ISO10W100" "" "" "LTSCALE" "3" ""))(princ)
(DEFUN C:SA5 () (setvar "DIMSCALE" 611.11111)
                  (COMMAND "-LAYER" "M" "NETDUT" "C" "8" "" "Lw" "0.12" "" "LT" "ACAD_ISO03W100" "" "" "LTSCALE" "10" ""
                           "-LAYER" "M" "TUONG" "C" "4" "" "Lw" "0.4" ""
                                       "M" "MANH" "C" "9" "" "Lw" "0.12" ""
                                    "M" "TEXT" "C" "7" "" "Lw" "0.12" ""
                                    "M" "DIM" "C" "1" "" "Lw" "0.2" ""
                                    "M" "THAY" "C" "7" "" "Lw" "0.2" ""
                                    "M" "NOITHAT" "C" "60" "" "Lw" "0.2" ""
                                    "M" "HATCH" "C" "5" "" "Lw" "0.1" ""
                                    "M" "COT" "C" "1" "" "Lw" "0.4" ""
                                    "M" "Defpoints" "C" "7" ""
                                    "M" "0" "C" "3" "" "Lw" "0.2" ""
                                    "M" "CUA" "C" "6" "" "Lw" "0.12" ""
                                    "M" "CUA MATDUNG" "C" "6" "" "Lw" "0.12" ""
                                    "M" "DAY-DIEN" "C" "3" "" "Lw" "0.4" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETDAM" "C" "4" "" "Lw" "0.4" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETTHAY" "C" "255" "" "Lw" "0.6" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETMANH" "C" "43" "" "Lw" "0.4" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "ThietBiDIEN" "C" "2" "" "Lw" "0.4" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTTXT" "C" "7" "" "Lw" "0.4" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTVN" "C" "60" "" "Lw" "0.4" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTVNi" "C" "60" "" "Lw" "0.4" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "THEPDAI" "C" "3" "" "Lw" "0.6" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "THEPDOC" "C" "2" "" "Lw" "1.40" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "10-VAN_KHOA" "C" "10" "" "Lw" "0.4" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "4-WateR_IN" "C" "4" "" "Lw" "0.5" "" "LT" "FENCELINE1" "" "" "LTSCALE" "2"
                                    "M" "4-WateR_OUT" "C" "4" "" "Lw" "0.5" "" "LT" "FENCELINE2" "" "" "LTSCALE" "2"
                                    "M" "KHUNGTEN" "C" "4" "" "Lw" "0.8" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TIMTUONG" "C" "5" "" "Lw" "0.15" "" "LT" "ACAD_ISO10W100" "" "" "LTSCALE" "5" ""))(princ)
(DEFUN C:SA4 () (setvar "DIMSCALE" 1411.1111)
                  (COMMAND "-LAYER" "M" "NETDUT" "C" "8" "" "Lw" "0.2" "" "LT" "ACAD_ISO03W100" "" "" "LTSCALE" "20" ""
                           "-LAYER" "M" "TUONG" "C" "4" "" "Lw" "0.6" ""
                                       "M" "MANH" "C" "9" "" "Lw" "0.2" ""
                                    "M" "TEXT" "C" "7" "" "Lw" "0.2" ""
                                    "M" "DIM" "C" "1" "" "Lw" "0.25" ""
                                    "M" "THAY" "C" "7" "" "Lw" "0.35" ""
                                    "M" "NOITHAT" "C" "60" "" "Lw" "0.25" ""
                                    "M" "HATCH" "C" "5" "" "Lw" "0.15" ""
                                    "M" "COT" "C" "1" "" "Lw" "0.6" ""
                                    "M" "Defpoints" "C" "7" ""
                                    "M" "0" "C" "3" "" "Lw" "0.25" ""
                                    "M" "CUA" "C" "6" "" "Lw" "0.25" ""
                                    "M" "CUA MATDUNG" "C" "6" "" "Lw" "0.25" ""
                                    "M" "DAY-DIEN" "C" "3" "" "Lw" "0.5" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETDAM" "C" "4" "" "Lw" "0.6" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETTHAY" "C" "255" "" "Lw" "0.7" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETMANH" "C" "43" "" "Lw" "0.5" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "ThietBiDIEN" "C" "2" "" "Lw" "0.5" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTTXT" "C" "7" "" "Lw" "0.5" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTVN" "C" "60" "" "Lw" "0.5" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTVNi" "C" "60" "" "Lw" "0.5" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "THEPDAI" "C" "3" "" "Lw" "0.7" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "THEPDOC" "C" "2" "" "Lw" "1.58" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "10-VAN_KHOA" "C" "10" "" "Lw" "0.5" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "4-WateR_IN" "C" "4" "" "Lw" "0.6" "" "LT" "FENCELINE1" "" "" "LTSCALE" "2"
                                    "M" "4-WateR_OUT" "C" "4" "" "Lw" "0.6" "" "LT" "FENCELINE2" "" "" "LTSCALE" "2"
                                    "M" "KHUNGTEN" "C" "4" "" "Lw" "1.00" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TIMTUONG" "C" "5" "" "Lw" "0.2" "" "LT" "ACAD_ISO10W100" "" "" "LTSCALE" "10" ""))(princ)

(DEFUN C:SA3 () (setvar "DIMSCALE" 1611.1111)
                  (COMMAND "-LAYER" "M" "NETDUT" "C" "8" "" "Lw" "0.35" "" "LT" "ACAD_ISO03W100" "" "" "" "LTSCALE" "30" ""
                           "-LAYER" "M" "TUONG" "C" "4" "" "Lw" "0.7" ""
                                       "M" "MANH" "C" "9" "" "Lw" "0.25" ""
                                    "M" "TEXT" "C" "7" "" "Lw" "0.2" ""
                                    "M" "DIM" "C" "1" "" "Lw" "0.35" ""
                                    "M" "THAY" "C" "7" "" "Lw" "0.4" ""
                                    "M" "NOITHAT" "C" "60" "" "Lw" "0.25" ""
                                    "M" "HATCH" "C" "5" "" "Lw" "0.2" ""
                                    "M" "COT" "C" "1" "" "Lw" "0.7" ""
                                    "M" "Defpoints" "C" "7" ""
                                    "M" "0" "C" "3" "" "Lw" "0.25" ""
                                    "M" "CUA" "C" "6" "" "Lw" "0.35" ""
                                    "M" "CUA MATDUNG" "C" "6" "" "Lw" "0.3" ""
                                    "M" "DAY-DIEN" "C" "3" "" "Lw" "0.5" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETDAM" "C" "4" "" "Lw" "0.6" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETTHAY" "C" "255" "" "Lw" "0.7" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETMANH" "C" "43" "" "Lw" "0.5" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "ThietBiDIEN" "C" "2" "" "Lw" "0.5" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTTXT" "C" "7" "" "Lw" "0.5" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTVN" "C" "60" "" "Lw" "0.5" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTVNi" "C" "60" "" "Lw" "0.5" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "THEPDAI" "C" "3" "" "Lw" "0.7" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "THEPDOC" "C" "2" "" "Lw" "1.58" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "10-VAN_KHOA" "C" "10" "" "Lw" "0.5" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "4-WateR_IN" "C" "4" "" "Lw" "0.6" "" "LT" "FENCELINE1" "" "" "LTSCALE" "2"
                                    "M" "4-WateR_OUT" "C" "4" "" "Lw" "0.6" "" "LT" "FENCELINE2" "" "" "LTSCALE" "2"
                                    "M" "KHUNGTEN" "C" "4" "" "Lw" "1.00" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TIMTUONG" "C" "5" "" "Lw" "0.25" "" "LT" "ACAD_ISO10W100" "" "" "LTSCALE" "20" ""))(princ)

(DEFUN C:SA2 () (setvar "DIMSCALE" 4111.1111)
                  (COMMAND "-LAYER" "M" "NETDUT" "C" "8" "" "Lw" "0.35" "" "LT" "ACAD_ISO03W100" "" "" "" "LTSCALE" "45" ""
                           "-LAYER" "M" "TUONG" "C" "4" "" "Lw" "0.7" ""
                                       "M" "MANH" "C" "9" "" "Lw" "0.25" ""
                                    "M" "TEXT" "C" "7" "" "Lw" "0.25" ""
                                    "M" "DIM" "C" "1" "" "Lw" "0.3" ""
                                    "M" "THAY" "C" "7" "" "Lw" "0.4" ""
                                    "M" "NOITHAT" "C" "60" "" "Lw" "0.3" ""
                                    "M" "HATCH" "C" "5" "" "Lw" "0.2" ""
                                    "M" "COT" "C" "1" "" "Lw" "0.7" ""
                                    "M" "Defpoints" "C" "7" ""
                                    "M" "0" "C" "3" "" "Lw" "0.35" ""
                                    "M" "CUA" "C" "6" "" "Lw" "0.35" ""
                                    "M" "CUA MATDUNG" "C" "6" "" "Lw" "0.3" ""
                                    "M" "DAY-DIEN" "C" "3" "" "Lw" "0.6" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETDAM" "C" "4" "" "Lw" "0.7" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETTHAY" "C" "255" "" "Lw" "0.8" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETMANH" "C" "43" "" "Lw" "0.6" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "ThietBiDIEN" "C" "2" "" "Lw" "0.6" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTTXT" "C" "7" "" "Lw" "0.6" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTVN" "C" "60" "" "Lw" "0.6" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTVNi" "C" "60" "" "Lw" "0.6" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "THEPDAI" "C" "3" "" "Lw" "0.8" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "THEPDOC" "C" "2" "" "Lw" "1.58" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "10-VAN_KHOA" "C" "10" "" "Lw" "0.6" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "4-WateR_IN" "C" "4" "" "Lw" "0.7" "" "LT" "FENCELINE1" "" "" "LTSCALE" "2"
                                    "M" "4-WateR_OUT" "C" "4" "" "Lw" "0.7" "" "LT" "FENCELINE2" "" "" "LTSCALE" "2"
                                    "M" "KHUNGTEN" "C" "4" "" "Lw" "1.20" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TIMTUONG" "C" "5" "" "Lw" "0.25" "" "LT" "ACAD_ISO10W100" "" "" "LTSCALE" "30" ""))(princ)

(DEFUN C:SA1 () (setvar "DIMSCALE" 4411.1111)
                  (COMMAND "-LAYER" "M" "NETDUT" "C" "8" "" "Lw" "0.4" "" "LT" "ACAD_ISO03W100" "" "" "" "LTSCALE" "60" ""
                           "-LAYER" "M" "TUONG" "C" "4" "" "Lw" "0.85" ""
                                       "M" "MANH" "C" "9" "" "Lw" "0.35" ""
                                    "M" "TEXT" "C" "7" "" "Lw" "0.5" ""
                                    "M" "DIM" "C" "1" "" "Lw" "0.35" ""
                                    "M" "THAY" "C" "7" "" "Lw" "0.4" ""
                                    "M" "NOITHAT" "C" "60" "" "Lw" "0.35" ""
                                    "M" "HATCH" "C" "5" "" "Lw" "0.25" ""
                                    "M" "COT" "C" "1" "" "Lw" "0.85" ""
                                    "M" "Defpoints" "C" "7" ""
                                    "M" "0" "C" "3" "" "Lw" "0.35" ""
                                    "M" "CUA" "C" "6" "" "Lw" "0.4" ""
                                    "M" "CUA MATDUNG" "C" "6" "" "Lw" "0.35" ""
                                    "M" "DAY-DIEN" "C" "3" "" "Lw" "0.7" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETDAM" "C" "4" "" "Lw" "0.8" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETTHAY" "C" "255" "" "Lw" "0.9" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETMANH" "C" "43" "" "Lw" "0.7" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "ThietBiDIEN" "C" "2" "" "Lw" "1.0" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTTXT" "C" "7" "" "Lw" "0.7" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTVN" "C" "60" "" "Lw" "0.7" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTVNi" "C" "4" "" "Lw" "0.7" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "THEPDAI" "C" "3" "" "Lw" "0.9" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "THEPDOC" "C" "2" "" "Lw" "2.00" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "10-VAN_KHOA" "C" "10" "" "Lw" "0.7" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "4-WateR_IN" "C" "4" "" "Lw" "0.8" "" "LT" "FENCELINE1" "" "" "LTSCALE" "2"
                                    "M" "4-WateR_OUT" "C" "4" "" "Lw" "0.8" "" "LT" "FENCELINE2" "" "" "LTSCALE" "2"
                                    "M" "KHUNGTEN" "C" "4" "" "Lw" "1.40" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TIMTUONG" "C" "5" "" "Lw" "0.3" "" "LT" "ACAD_ISO10W100" "" "" "LTSCALE" "40" ""))(princ)

(DEFUN C:SA0 () (setvar "DIMSCALE" 6111.1111)
                  (COMMAND "-LAYER" "M" "NETDUT" "C" "8" "" "Lw" "0.5" "" "LT" "ACAD_ISO03W100" "" "" "" "LTSCALE" "85" ""
                           "-LAYER" "M" "TUONG" "C" "4" "" "Lw" "1" ""
                                       "M" "MANH" "C" "9" "" "Lw" "0.35" ""
                                    "M" "TEXT" "C" "7" "" "Lw" "0.5" ""
                                    "M" "DIM" "C" "1" "" "Lw" "0.35" ""
                                    "M" "THAY" "C" "7" "" "Lw" "0.5" ""
                                    "M" "NOITHAT" "C" "60" "" "Lw" "0.4" ""
                                    "M" "HATCH" "C" "5" "" "Lw" "0.35" ""
                                    "M" "COT" "C" "1" "" "Lw" "0.1" ""
                                    "M" "Defpoints" "C" "7" ""
                                    "M" "0" "C" "3" "" "Lw" "0.5" ""
                                    "M" "CUA" "C" "6" "" "Lw" "0.5" ""
                                    "M" "CUA MATDUNG" "C" "6" "" "Lw" "0.4" ""
                                    "M" "DAY-DIEN" "C" "3" "" "Lw" "0.8" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETDAM" "C" "4" "" "Lw" "1" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETTHAY" "C" "255" "" "Lw" "1.00" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "NETMANH" "C" "43" "" "Lw" "0.8" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "ThietBiDIEN" "C" "2" "" "Lw" "1.20" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTTXT" "C" "7" "" "Lw" "0.8" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTVN" "C" "60" "" "Lw" "0.8" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TEXTVNi" "C" "60" "" "Lw" "0.8" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "THEPDAI" "C" "3" "" "Lw" "1.00" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "THEPDOC" "C" "2" "" "Lw" "2.11" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "10-VAN_KHOA" "C" "10" "" "Lw" "0.8" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "4-WateR_IN" "C" "4" "" "Lw" "0.9" "" "LT" "FENCELINE1" "" "" "LTSCALE" "2"
                                    "M" "4-WateR_OUT" "C" "4" "" "Lw" "0.9" "" "LT" "FENCELINE2" "" "" "LTSCALE" "2"
                                    "M" "KHUNGTEN" "C" "4" "" "Lw" "1.40" "" "LT" "Continuous" "" "" "LTSCALE" "1"
                                    "M" "TIMTUONG" "C" "5" "" "Lw" "0.35" "" "LT" "ACAD_ISO10W100" "" "" "LTSCALE" "55" ""))(princ)
(DEFUN C:O () (COMMAND "OFFSET"))
(defun c:s1 () (command "surftab1"))
(defun c:s2 () (command "surftab2"))
(defun c:ep () (command "explode"))
(DEFUN C

S () (COMMAND "AUDIT" "Y" "purge" "all" "*" "N" "QSAVE"))
(DEFUN C

V () (COMMAND "QSAVE"))
(DEFUN C:S () (COMMAND "STRETCH" "C"))

;************************** CAT DIM **************************

(DEFUN C

C (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI PT13I PT14I
            PT13N PT14N O13 O14 N13 N14 OSM OLDERR PT10 PT11)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
   *error* myerror)
(PRINC "Please select dimension object!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Point to trim or extend:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
(PROGN
      (SETQ DS (ENTGET (SSNAME SS DEM)))
      (SETQ KDL (CDR (ASSOC 0 DS)))
      (IF (= "DIMENSION" KDL)
         (PROGN
            (SETQ PT10 (CDR (ASSOC 10 DS)))
            (SETQ PT11 (CDR (ASSOC 11 DS)))
            (SETQ PT13 (CDR (ASSOC 13 DS)))
            (SETQ PT14 (CDR (ASSOC 14 DS)))
            (SETQ N70 (CDR (ASSOC 70 DS)))
            (IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
               (PROGN
                     (SETQ GOCY (ANGLE PT10 PT14))
                     (SETQ GOCX (+ GOCY (/ PI 2)))
               )
            )
            (SETVAR "OSMODE" 0)
            (SETQ PTI (POLAR PT GOCX 2))
            (SETQ PT13I (POLAR PT13 GOCY 2))
            (SETQ PT14I (POLAR PT14 GOCY 2))
            (SETQ PT13N (INTERS PT PTI PT13 PT13I NIL))
            (SETQ PT14N (INTERS PT PTI PT14 PT14I NIL))
            (SETQ O13 (ASSOC 13 DS))
            (SETQ O14 (ASSOC 14 DS))
            (SETQ N13 (CONS 13 PT13N))
            (SETQ N14 (CONS 14 PT14N))
            (SETQ DS (SUBST N13 O13 DS))
            (SETQ DS (SUBST N14 O14 DS))
            (ENTMOD DS)
         )
      )
      (SETQ DEM (+ DEM 1))
)
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR)             ; Restore old *error* handler
(PRINC)
)

(DEFUN C:BD (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI
            PT10 PT10I PT10N O10 N10 PT11 PT11N O11 N11 KC OSM OLDERR)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
   *error* myerror)
(PRINC "Please select dimension object!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Point to trim or extend:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
(PROGN
      (SETQ DS (ENTGET (SSNAME SS DEM)))
      (SETQ KDL (CDR (ASSOC 0 DS)))
      (IF (= "DIMENSION" KDL)
         (PROGN
            (SETQ PT13 (CDR (ASSOC 13 DS)))
            (SETQ PT14 (CDR (ASSOC 14 DS)))
            (SETQ PT10 (CDR (ASSOC 10 DS)))
            (SETQ PT11 (CDR (ASSOC 11 DS)))
            (SETQ N70 (CDR (ASSOC 70 DS)))
            (IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
               (PROGN
                     (SETQ GOCY (ANGLE PT10 PT14))
                     (SETQ GOCX (+ GOCY (/ PI 2)))
               )
            )
            (SETVAR "OSMODE" 0)
            (SETQ PTI (POLAR PT GOCX 2))
            (SETQ PT10I (POLAR PT10 GOCY 2))
            (SETQ PT10N (INTERS PT PTI PT10 PT10I NIL))
            (SETQ KC (DISTANCE PT10 PT10N))
            (SETQ O10 (ASSOC 10 DS))
            (SETQ N10 (CONS 10 PT10N))
            (SETQ DS (SUBST N10 O10 DS))
            (SETQ PT11N (POLAR PT11 (ANGLE PT10 PT10N) KC))
            (SETQ O11 (ASSOC 11 DS))
            (SETQ N11 (CONS 11 PT11N))
            (SETQ DS (SUBST N11 O11 DS))
            (ENTMOD DS)
         )
      )
      (SETQ DEM (+ DEM 1))
)
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR)
(PRINC)
)

;;; ================ BAT - TAT CHE DO GACH CHAN TEXT (TU) =================

(defun c:tu ()  (setvar "cmdecho" 0)(prompt "\nHay chon dong TEXT can gach chan ")
      (prompt "\nSelect objects: ")(command "select" "au" pause)(setq sstxt (ssget "p")
      sslen (sslength sstxt) ctr 0)(command ".undo" "mark")(while (< ctr sslen)(setq listxt
      (entget (ssname sstxt ctr))txttxt (cdr (assoc 1 listxt))enttxt (cdr (assoc 0 listxt)))
      (if (= enttxt "TEXT")(progn(setq testxt (substr txttxt 1 3))(if (or (= testxt "%%u")
      (= testxt "%%U"))(setq newtxt (substr txttxt 4))(setq newtxt (strcat "%%u" txttxt)))
      (setq listxt (subst (cons 1 newtxt) (assoc 1 listxt) listxt))(entmod listxt)))
      (setq ctr (1+ ctr))  ) (setvar "cmdecho" 1) (princ))

;;; ================ CHEN COT (TUU) =================

(defun c:tuu ()  (setvar "cmdecho" 0)(prompt "\nHay chon dong TEXT can chen cot ")
      (prompt "\nSelect objects: ")(command "select" "au" pause)(setq sstxt (ssget "p")
      sslen (sslength sstxt) ctr 0)(command ".undo" "mark")(while (< ctr sslen)(setq listxt
      (entget (ssname sstxt ctr))txttxt (cdr (assoc 1 listxt))enttxt (cdr (assoc 0 listxt)))
      (if (= enttxt "TEXT")(progn(setq testxt (substr txttxt 1 3))(if (or (= testxt "%%p 0,000")
      (= testxt "%%P 0,000"))(setq newtxt (substr txttxt 4))(setq newtxt (strcat "%%P 0,000" txttxt)))
      (setq listxt (subst (cons 1 newtxt) (assoc 1 listxt) listxt))(entmod listxt)))
      (setq ctr (1+ ctr))  ) (setvar "cmdecho" 1) (princ))

;;; ================ CHEN KY HIEU THEP (TP) =================

(defun c:tp ()  (setvar "cmdecho" 0)(prompt "\nHay chon dong TEXT can chen ky hieu thep ")
      (prompt "\nSelect objects: ")(command "select" "au" pause)(setq sstxt (ssget "p")
      sslen (sslength sstxt) ctr 0)(command ".undo" "mark")(while (< ctr sslen)(setq listxt
      (entget (ssname sstxt ctr))txttxt (cdr (assoc 1 listxt))enttxt (cdr (assoc 0 listxt)))
      (if (= enttxt "TEXT")(progn(setq testxt (substr txttxt 1 3))(if (or (= testxt "%%c")
      (= testxt "%%C"))(setq newtxt (substr txttxt 4))(setq newtxt (strcat "%%c" txttxt)))
      (setq listxt (subst (cons 1 newtxt) (assoc 1 listxt) listxt))(entmod listxt)))
      (setq ctr (1+ ctr))  ) (setvar "cmdecho" 1) (princ))

;=========================== TAM TUONG (TAM) =================================

(defun c:tam(/ data_m)
         (defun import_data(/ i)(setq data_m (ssget))(if (= nil distan_m) (setq distan_m 110.0))
         (princ "Distance (")(princ distan_m)(princ "):")(setq i (getreal ))(if (not (= nil i))
      (setq distan_m i)))(defun process(/ ent check)(defun p_check()(setq check 0)
      (if (= "LINE" (cdr (assoc 0 ent))) (setq check 1))(princ))(defun p_d_offset
      (/ p1 p2 p3 p4)(defun makeline(/ e2 e5)(setq la (list (cons 0 "LINE")(cons 5 (cdr
      (assoc 5 ent)))(cons 8 (cdr (assoc 8 ent)))(cons 10 p3)(cons 11 p4)))(entmake la)(princ)
      )(setq p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)))(if (not (= p1 p2)) (progn (if
      (< (abs (- (nth 0 p1) (nth 0 p2))) 0.000001) (progn (setq p3 (list (+ (nth 0 p1)
      distan_m) (nth 1 p1) (nth 2 p1)))(setq p4 (list (+ (nth 0 p2) distan_m)(nth 1 p2)
      (nth 2 p2))) (makeline) (setq p3 (list (- (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1)))
      (setq p4 (list (- (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2))) (makeline)))(if (<
      (abs (- (nth 1 p1) (nth 1 p2))) 0.000001) (progn (setq p3 (list (nth 0 p1) (+ (nth 1 p1)
      distan_m) (nth 2 p1)))(setq p4 (list (nth 0 p2) (+ (nth 1 p2) distan_m) (nth 2 p2)))
      (makeline) (setq p3 (list (nth 0 p1) (- (nth 1 p1) distan_m) (nth 2 p1))) (setq p4
      (list (nth 0 p2) (- (nth 1 p2) distan_m) (nth 2 p2)))(makeline)))))(princ))(if (not
      (= nil data_m)) (progn (setq i 0)(while (< i (sslength data_m)) (progn(setq ent (entget
      (ssname data_m i)))(p_check)(if (= 1 check) (p_d_offset))(setq i (+ i 1))))))(princ))
      (import_data)(ai_undo_push)(process)(ai_undo_pop)(princ))

;============ GHI CHU PHI (T1) ================

(defun c:DuongDan ()(setq D1 (getpoint " Diem thu nhat: "))(setq D2 (getpoint "Diem thu hai: " D1))
      (if (> (car D2) (car D1)) (setq D3 (polar D2 0 16)))(if (< (car D2) (car D1)) (setq D3
      (polar D2 PI 16)))(if (= (car D2) (car D1)) (setq D3 (polar D2 0 16)))(if (> (car D2)
      (car D1)) (setq D4 (polar D3 0 3.2)))(if (< (car D2)(car D1))(setq D4 (polar D3 PI 3.2)
      ))(if (= (car D2) (car D1)) (setq D4 (polar D3 0 3.2)))(if (> (car D2) (car D1))
      (setq D5 (polar D2 (/ PI 9) 3)))(if (< (car D2) (car D1)) (setq D5 (polar D3 (/ PI 9)
      3)))(if (= (car D2) (car D1)) (setq D5 (polar D2 (/ PI 9) 3)))(command "color" 1)
      (command "line" D1 D2 D3 "")(command "circle" D4 "3.5")(command "color" 7 )
      (command "text" "m" D4 2.5 0 "1")(command "text" D5 2.5 0 "%%c6a150")
      (command "ddedit" pause))

;;; ========================== Join (J) =================

(defun C:J () (Setvar "cmdecho" 0)(setq m:err *error* *error* *merrmsg*)(setq sset (ssget))
         (if (null sset) (exit))(setq kt (getstring "\nJoin all (Y/N) <Y> ? "))
      (setq ssl (sslength sset))(setq temp  (entget (ssname sset 0))etype (cdr (assoc 0 temp)
      ))(cond((or (= kt "Y") (= kt "y") (= kt ""))(progn (cond((= etype "POLYLINE")
      (COMMAND "PEDIT" sset "J" "all" "" ""))(if (or (= etype "LINE") (= etype "ARC"))
         (COMMAND "PEDIT" sset "" "J" "all" "" "")))))((or (/= kt "Y") (/= kt "y") (/= kt ""))
      (progn (cond((= etype "POLYLINE")(COMMAND "PEDIT" sset "J" sset "" ""))
         (if (or (= etype "LINE") (= etype "ARC"))(COMMAND "PEDIT" sset "" "J" sset "" ""))))))
      (setq *error* m:err m:err nil)(princ))

;=====================================================================
;;; DOOR.LSP 1.0, Copyright (C) 1998 by CAD Department, HUCE.
;=====================================================================

(defun C:D1 (/ p1 p2 p3 p4 side dis wid ang angsile old)
(setq old (getvar "OSMODE"))

(setq p1 (getpoint "\nStart point:"))
(setq p2 (getpoint p1 "\nEnd point:"))
(setq side (getpoint p2 "\nOpen side"))

(setq dis (distance p1 p2))
(setq ang (angle p1 p2))
(if (< ang (angle p1 side))
  (setq angside (/ pi 2) )
  (setq angside (- (/ pi 2)))
)
(if  (>= (- (angle p1 side) ang) pi)
  (setq angside (- (/ pi 2)))
)
(if  (>= (- ANG (angle p1 side) ) pi)
  (setq angside (/ pi 2))
)

(setq p3 (polar p2 (+ ang angside) dis) )
(setq p4 (polar p1 (+ ang angside) dis) )
(setq wid (/ dis 15))

(setvar "OSMODE" 0)

(command "PLINE" p1 "A" "D" p4 p3 "L" p2
               (polar p2 (+ ang pi) wid)
               (polar p3 (+ ang pi) wid)
"")

(setvar "OSMODE" old)
(princ)
)

;=====================================================================

(defun C:D2 (/ p1 p2 p3 p4 side dis wid ang angsile old)
(defun cua1 (pt1 pt2)
  (setq p1 pt1
      p2 pt2)

  (setq ang (angle p1 p2))
  (if (< ang (angle p1 side))
(setq angside (/ pi 2) )
(setq angside (- (/ pi 2)))
  )
  (if  (>= (- (angle p1 side) ang) pi)
(setq angside (- (/ pi 2)))
  )
  (if  (>= (- ANG (angle p1 side) ) pi)
(setq angside (/ pi 2))
  )

  (setq p3 (polar p2 (+ ang angside) dis) )
  (setq p4 (polar p1 (+ ang angside) dis) )
  (setq wid (/ dis 15))

  (command "PLINE" p1 "A" "D" p4 p3 "L" p2
               (polar p2 (+ ang pi) wid)
               (polar p3 (+ ang pi) wid)
  "")
)
;=====================================================================
(setq old (getvar "OSMODE"))

(setq p1 (getpoint "\nStart point:"))
(setq p2 (getpoint p1 "\nEnd point:"))
(setq side (getpoint p2 "\nOpen side"))

(setq dis (distance p1 p2))
(setq dis (/ dis 2))

(setvar "OSMODE" 0)

(setq p1 (polar p1 (angle p1 p2) dis))
(cua1 p1 p2)

(setq ang (+ ang pi))
(setq p2 (polar p1 ang dis))
; (setq side (polar p1 () dis))
(cua1 p1 p2)

(setvar "OSMODE" old)
(princ)
)

;=====================================================================
;"Glue" text strings.  All adopt first's properties.
;       Author:
;             Henry C. Francis
;             425 N. Ashe St.
;             Southern Pines, NC 28387
;       http://www.pinehurst.net/~pfrancis
;       e-mail hfrancis@pinehurst.net
;       All rights reserved.
(defun c:gst ( / ename ent1 ent2 old1 oldsl old10 old11 old40 old50 newstr newsl new1 new10 new11)
(while
  (not
(and
   (setq ename1 (car(entsel "\nSelect first text string to join: ")))
   (setq ent1 (entget ename1))
   (eq(cdr(assoc 0 ent1))"TEXT")
);and
  );not
);while
(setq old1 (cdr(assoc 1 ent1)))
(while
  (not
(and
   (setq ename2 (car(entsel "\nSelect second text string to join: ")))
   (setq ent2 (entget ename2))
   (eq(cdr(assoc 0 ent2))"TEXT")
   (not(eq ename1 ename2))
);and
  );not
);while
(setq old2 (cdr(assoc 1 ent2)))
(setq new1 (strcat old1 " " old2)
   ent1
      (subst (cons 1 new1)
            (assoc 1 ent1)
            ent1)
);setq
(entmod ent1)
(entdel ename2)
(princ)
);defun

;=====================================================================

(defun c:nt (/ g1 g2 ss1 olderr nterr l i temp e1 e2 new old dd dc)

(defun nterr (s)
      (command "_.UCS" "" "_.UNDO" "E")
      (setvar "cmdecho" 1)
      (setvar "blipmode" 0)
      (setq *error* olderr)
      (setq g1 nil g2 nil ss1 nil e1 nil e2 nil olderr nil
            nterr nil temp nil i nil l nil new nil old nil dd nil dc nil)
      (princ)
)

(defun tim_in (dt / p01 p02 ktra)
      (setq p01 (cdr (assoc 10 (entget dt))))
      (setq p02 (cdr (assoc 11 (entget dt))))
      (setq ktra T)
      (if (and (> (car p01) (car g1)) (< (car p01) (car g2))
               (> (cadr p01) (cadr g1)) (< (cadr p01) (cadr g2)))
         (setq ktra nil)
      )
      (if (and (> (car p02) (car g1)) (< (car p02) (car g2))
               (> (cadr p02) (cadr g1)) (< (cadr p02) (cadr g2)))
         (setq ktra nil)
      )
      ktra
)

(defun timdt (dt1 dt2 / p01 p02)
      (setq p01 (cdr (assoc 10 (entget dt2))))
      (setq p02 (cdr (assoc 11 (entget dt2))))
      (setvar "ucsicon" 0)
      (command "_.UCS" "E" dt1)
      (setq p01 (trans p01 0 1))
      (setq p02 (trans p02 0 1))
      (command "_.UCS" "")
      (setvar "ucsicon" 1)
      (if (and (equal (cadr p01) 0 0.001) (equal (cadr p02) 0 0.001))
            T
            nil
      )
)

(defun tim_out (dt / p01 p02 kt)
      (setq p01 (cdr (assoc 10 (entget dt))))
      (setq p02 (cdr (assoc 11 (entget dt))))
      (if (and (> (car p01) (car g1)) (< (car p01) (car g2))
               (> (cadr p01) (cadr g1)) (< (cadr p01) (cadr g2)))
         (setq kt p02)
      )
      (if (and (> (car p02) (car g1)) (< (car p02) (car g2))
               (> (cadr p02) (cadr g1)) (< (cadr p02) (cadr g2)))
         (setq kt p01)
      )
      kt
)

(setvar "cmdecho" 0)
(setq olderr *error* *error* nterr)
(command "_.UNDO" "G" "_.UCS" "")
(while (null ss1)
      (princ "\nChon tuong muon noi...")
      (initget 1)
      (setq g1 (getpoint "\n>Goc thu nhat:"))
      (initget (+ 1 32))
      (setq g2 (getcorner g1 "\n>Goc thu hai:"))
      (setq ss1 (ssget "c" g1 g2 '((0 . "LINE"))))
      (if (null ss1) (princ "\nKhong tim thay doi tuong!"))
)

(setq temp (list (min (car g1) (car g2)) (min (cadr g1) (cadr g2)))
      g2 (list (max (car g1) (car g2)) (max (cadr g1) (cadr g2)))
      g1 temp)
(setq ss1 (ssget "w" g1 g2))
(if ss1 (command "_.ERASE" ss1 ""))
(setq ss1 (ssget "c" g1 g2 '((0 . "LINE"))))

(setvar "blipmode" 0)
      (setq i 0 l (sslength ss1))
      (while (< i l)
         (if (tim_in (ssname ss1 i))
            (progn
                  (ssdel (ssname ss1 i) ss1)
                  (setq i 0 l (1- l))
            )
            (setq i (1+ i))
         )
      )
      (setq l (sslength ss1))
   (while (>= l 2)
      (setq e1 (ssname ss1 0))
      (ssdel e1 ss1)
      (setq e2 nil i 0 l (sslength ss1))
         (while (< i l)
            (if (timdt e1 (ssname ss1 i))
                  (progn
                     (setq e2 (ssname ss1 i))
                           (setq dd (tim_out e1))
                           (setq dc (tim_out e2))
                  )
            )
            (setq i (1+ i))
         )
         (if e2 (progn
                     (ssdel e2 ss1)
                     (command "_.ERASE" e2 "")
                     (setq temp (entget e1))
                     (setq old (assoc 10 temp))
                     (setq new (cons 10 dd))
                     (setq temp (subst new old temp))
                     (entmod temp)
                     (setq temp (entget e1))
                     (setq old (assoc 11 temp))
                     (setq new (cons 11 dc))
                     (setq temp (subst new old temp))
                     (entmod temp)
                     (redraw e1)
                     (setq l (sslength ss1))
               )
         )
      )

      (command "_.UCS" "" "_.UNDO" "E")
      (setvar "cmdecho" 1)
      (setvar "blipmode" 0)
      (setq *error* olderr)
      (princ)
)
;*********************************************************************
(defun ketthuc ()
      (setvar       "cmdecho"       luuecho)
      (setq *error*       luu
            luu             nil
            luuecho       nil
      );setq
      (princ)
)
;*********************************************************************
(defun modau ()
(setq       luu *error
            luuecho       (getvar       "cmdecho")
            *error       (ketthuc)
)
)
;*********************************************************************
(defun xulytext (text / kytu ma sokt luusokt lui )
(setq       kytu       (substr text (strlen text))
            ma       (ascii kytu)
            sokt       (read kytu)
            lui       1
)
(if (numberp sokt)
            (progn
                     (setq luusokt       (1+ sokt))
                     (if (and       (numberp sokt)
                                    (> (strlen text) 1)
                        )
                        (progn
                              (setq       kytu       (substr text (1- (strlen text)))
                                             sokt       (read kytu)
                                                                              )
                              (if       (numberp sokt)
                                    (setq luusokt (1+       sokt)
                                                      lui       2

                                             )
                              )
                        );progn
                     )
                     (if (= luusokt       100)       (setq       luusokt       0))
                     (setq       kytu             (rtos luusokt 2 0)

                                    text       (strcat       (substr text 1 (- (strlen text) lui))  kytu)
                     )
            );progn
            (if (or       (= kytu "z")
                              (= kytu "Z")
                     )
                     (setq       text             (strcat       text       "0")
                              textxl             "0"
                     )
                     (setq             ma       (1+       ma)
                                    text       (strcat       (substr text 1 (1- (strlen text)))  (chr ma))
                     )
            );if
);if
)
;*********************************************************************
(defun doitext(tendoituong / chuoi doituong thoat tam dsach kieu text vitri10 vitri11 dem canle)
;Neu doi tuong la text thi tiep tuc
(setq       doituong       (entget  tendoituong)
      kieu             (cdr (assoc       0       doituong))
      canle             (cdr (assoc       72       doituong))
)
(if (or (= kieu             "TEXT")
      (= kieu       "MTEXT")
)
      (progn
            (setq       textxl       (xulytext textxl)
                     text       (cons 1 textxl)
                     vitri10       (cdr (assoc 10 doituong))
                     vitri10       (list (+ (car vitri10) (car vitrilech)) (+ (nth 1 vitri10) (nth 1 vitrilech)))
                     vitri10             (cons 10 vitri10)
                     vitri11       (cdr (assoc 11 doituong))
                     vitri11       (list (+ (car vitri11) (car vitrilech)) (+ (nth 1 vitri11) (nth 1 vitrilech)))
                     vitri11             (cons 11 vitri11)
                     dem       0
                     dsach       nil
            )
            (foreach tam       doituong
                     (cond
                              ((= (car tam)       1)       (setq dsach       (append dsach (list text))))
                              ((= (car tam)       10)       (setq dsach       (append dsach (list vitri10))))
                              ((= (car tam)       11)       (setq dsach       (append dsach (list vitri11))))
                              ((setq dsach       (append dsach (list tam))))
                     )
            )
            (entmake dsach)
      );progn
);if
      );
;*********************************************************************
;sao doi tuong cu sang vi tri moi

(defun copy_dt (tendoituong )
(command "copy" tendoituong "" goc toi )
);defun

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

(defun c:ct ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
(princ "\nCopy Inteligent...\n")
(setq       luuecho       (getvar       "cmdecho")
      luu       *error*
      *error*       ketthuc
      cumdt       (ssget)
      dodai       (sslength cumdt)
      goc             (getpoint "\nSelect base point:")
      thoat             nil
      dem             0
      textxl             nil
);
(setvar "cmdecho" 0)
; Loc ra duoc ong text de xu ly
(while       (and       (= thoat       nil)
            (< dem       dodai)
      )
      (setq       ten       (ssname cumdt dem)
            dem       (1+       dem)
            doituong (entget ten)
            kieu       (cdr (assoc       0       doituong))
      )

      (if (or (= kieu             "TEXT")
            (= kieu       "MTEXT")
            )
            (setq       thoat       T
                     textxl       (cdr (assoc 1 doituong))
            )
      )
);
(while T
(setq       toi             (getpoint "\nSelect next point: " goc)
      vitrilech       (list       (- (car toi) (car goc)) (- (nth 1 toi) (nth 1 goc)))
      dem             0
)
(while       (< dem dodai)
      (setq       ten       (ssname cumdt dem)
            dem       (1+       dem)
            doituong (entget ten)
            kieu       (cdr (assoc       0       doituong))
      )

      (if (or (= kieu             "TEXT")
            (= kieu       "MTEXT")
            )
            (doitext       ten)
            (copy_dt       ten)

      );if
)
);while
(ketthuc)
);defun
(princ "Type \"DG\" to start")
;Note: bien toan cuc: textxl vitrilech

;=====================================================================
;;; PLJOINFUZZ.LSP
;;; Joins lines, arcs and polylines using a fuzz distance
;;; If only one object is selected it tries to join to all objects that are possible
;;; By Jimmy Bergmark
;;; Copyright (C) 2003-2004 JTB World, All Rights Reserved
;;; Website: www.jtbworld.com
;;; E-mail: info@jtbworld.com
;;; Tested on AutoCAD 2002,2004 and 2005
;;; Latest revision made 2004-11-11
;;; Minor code cosmetic change made 2004-11-13
;;; Bug corrected 2004-12-23

(defun c:jf () (c:pljoinfuzz)) ; this line can be commented out if there is an existing command called jf
(defun c:pljoinfuzz (/ ss1 entLine objType oldcmdecho oldpeditaccept fuzz okObjects)
  (setq oldcmdecho (getvar "cmdecho"))
  (setq oldpeditaccept (getvar "PEDITACCEPT"))
  (setvar "cmdecho" 0)
  (setq A2k4 (>= (substr (getvar "ACADVER") 1 2) "16"))
  (if A2k4 (setvar "PEDITACCEPT" 0))
  (setq       okObjects '((0 . "LINE,ARC,POLYLINE,LWPOLYLINE")))
  (princ "\nSelect object to join: ")
  (setq ss1 (ssget okObjects))
  (setq fuzz (getdist "\nFuzz distance <0>: "))
  (if (= fuzz nil) (setq fuzz 0))
  (if (/= ss1 nil)
   (progn
      (setq objType (cdr (assoc 0 (entget (setq entLine (ssname ss1 0))))))
      (if (= (sslength ss1) 1) (setq ss1 (ssget "X" okObjects)))
      (if (member objType '("LINE" "ARC"))
      (command "_.pedit" "_M" ss1 "" "_Y" "_J" "_J" "_B" fuzz "")
      (command "_.pedit" "_M" ss1 "" "_J" "_J" "_B" fuzz "")
      )
   )
  )
  (setvar "cmdecho" oldcmdecho)
  (if A2k4 (setvar "PEDITACCEPT" oldpeditaccept))
  (princ)
)

;===========================VE CAO TRINH===========================

(DEFUN C:Cotcao (/ CMD PT1 PT2 PT3 PT4 PT5 PT6 PT7 PT8 NPI TX DX DY TL OSM OLL
            CRST RSIZE TSIZE STR PRMT FCH NBC OLDERR)
(SETQ OLDERR *error*
   *error* loisb)
(command "layer" "m" "dim" "c" "" """")
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ NBC (GETVAR "CLAYER"))
(SETQ OSM (GETVAR "OSMODE"))
(SETVAR "CMDECHO" 0)
(SETQ PT1 (GETPOINT "\nDiem cao trinh:"))
(SETQ TX (GETSTRING "\nCao trinh:"))
(SETQ FCH (SUBSTR TX 1 1))
(IF (= FCH "@") (SETQ TX (STRCAT "%%P" (SUBSTR TX 2 (- (STRLEN TX) 1)))))
(SETQ CRST (GETVAR "TEXTSTYLE"))
(SETQ RSIZE (CDR (ASSOC 40 (TBLSEARCH "STYLE" CRST))))
(SETQ TSIZE (GETVAR "TEXTSIZE"))
(SETQ STR (RTOS TSIZE 2))
(SETQ PRMT (STRCAT "\nText height <" STR ">:"))
(IF (= RSIZE 0)
  (PROGN
      (INITGET 4)
      (SETQ TSIZE (GETREAL PRMT))
      (IF (= TSIZE NIL) (SETQ TSIZE (GETVAR "TEXTSIZE"))
                        (SETVAR "TEXTSIZE" TSIZE))
  )
)
(PRINC)
(SETQ TL (/ (GETVAR "TEXTSIZE") 2))
(SETVAR "OSMODE" 0)
(SETQ DX (CAAR (CDR (TEXTBOX (LIST (CONS 1 TX))))))
(SETQ NPI (/ PI 2))
(SETQ PT4 (POLAR PT1 NPI (* 1 TL)))
(SETQ PT2 (POLAR PT4 PI (* 2 TL)))
(SETQ PT3 (POLAR PT4 0 (* 2 TL)))
(SETQ PT5 (POLAR PT4 NPI (* 5 TL)))
(SETQ PT6 (POLAR PT2 NPI  TL))
(SETQ PT7 (POLAR PT6 0 (+ (* 3.7 TL) DX)))
(SETQ PT8 (POLAR PT6 NPI (* 1 TL)))
(SETQ PT8 (POLAR PT8 0 (* 2.5 TL)))
(SETQ PT9 (POLAR PT1 pi (* 2 TL)))
(SETQ PT10 (POLAR PT1 0 (* 2 TL)))
(COMMAND "COLOR" "7" "")
(COMMAND "STYLE" "COTES"  "tcvn3italic,vnh.shx" "" "1" "0" "n" "n" "n")
(IF (= RSIZE 0)(COMMAND "TEXT" PT8 TSIZE 0 tX) (COMMAND "TEXT" PT8 0 TX))
(COMMAND "COLOR" "BYLAYER" "")
(COMMAND "SOLID" PT1 PT2 PT4 "" "" "pLINE"  PT1 pt3 pt2  "")
(COMMAND "COLOR" "BYLAYER" "")
(COMMAND "pLINE" PT1 PT5 "" "pLINE" PT6 PT7 "" "pLINE" pt9 pt10"")
(SETVAR "CLAYER" "0")
(command "ddedit" pause)
(COMMAND "COLOR" "BYLAYER" "")
(SETVAR "CMDECHO" CMD)
(SETVAR "CLAYER" NBC)
(SETVAR "OSMODE" OSM)
(PRINC)
)

;;; =========================== VE NET CAT CHEO (GC) =============================

(Defun c:G1(/ p1 p2 p3 p4 p5 p6 p11 p12 l ang)
      (setq x (getvar "osmode"))
      (setq p1 (getpoint "First point : ")
            p2 (getpoint p1 "Second point : "))
      (setq l (distance p1 p2))
      (setq p11 (polar p1 (angle p2 p1) (/ l 5))
            p12 (polar p2 (angle p1 p2) (/ l 5)))
      (setq ang (angle p1 p2))
      (setq p3 (polar p1 ang (/ l 2.5))
            p4 (polar p3 (+ (/ pi 2) ang) (/ l 5))
            p5 (polar p3 ang (/ l 5))
            p6 (polar p5 (- ang (/ pi 2)) (/ l 5)))
      (setvar "osmode" 0)
(command "pline" p11 p3 p4 p6 p5 p12 "")
(setvar "osmode" x)
)
;----------------------------------------------------------------------------------
(Defun C:G2 (/  ps1  ps2  pf1  pf2  pf3  pf4  pf5  pf6
pf7  pf8  sb sh se ang  old_osmode); (setq old_osmode (getvar "OSMODE"))
(setq ps1 (getpoint "\Chon diem thu nhat: "))
(setq ps2 (getpoint ps1 "\nChon diem tiep theo: "))
(setq sb 50.0 sh 200.0 se 20.0)
(setq ang (angle ps1 ps2))
(setq pf1 (polar ps1 ang (- 0.0 se)))
(setq pf2 (polar ps1 ang (/ (- (distance ps1 ps2) sb) 2.0) ))
(setq pf3 (polar pf2 (+ ang (/ pi 2)) (/ sh 2.0)))
(setq pf5 (polar pf2 ang sb))
(setq pf4 (polar pf5 (- ang (/ pi 2)) (/ sh 2.0)))
(setq pf6 (polar ps2 ang se))
(setvar "OSMODE" 0)
(setvar "BLIPMODE" 0)
(command "PLINE" pf1 pf2 pf3 pf4 pf5 pf6 "")
(setvar "OSMODE" 703)
(princ) )
;----------------------------------------------------------------------------------
(Defun C:G3 (/  ps1  ps2  pf1  pf2  pf3  pf4  pf5  pf6
pf7  pf8  sb sh se ang  old_osmode); (setq old_osmode (getvar "OSMODE"))
(setq ps1 (getpoint "\Chon diem thu nhat: "))
(setq ps2 (getpoint ps1 "\nChon diem tiep theo: "))
(setq sb 100.0 sh 150.0 se 20.0)
(setq ang (angle ps1 ps2))
(setq pf1 (polar ps1 ang (- 0.0 se)))
(setq pf2 (polar ps1 ang (/ (- (distance ps1 ps2) sb) 2.0) ))
(setq pf3 (polar pf2 (+ ang (/ pi 2)) (/ sh 2.0)))
(setq pf5 (polar pf2 ang sb))
(setq pf4 (polar pf5 (- ang (/ pi 2)) (/ sh 2.0)))
(setq pf6 (polar ps2 ang se))
(setvar "OSMODE" 0)
(setvar "BLIPMODE" 0)
(command "PLINE" pf1 pf2 pf3 pf4 pf5 pf6 "")
(setvar "OSMODE" 703)
(princ) )
;----------------------------------------------------------------------------------
(Defun C:G4 (/  ps1  ps2  pf1  pf2  pf3  pf4  pf5  pf6
pf7  pf8  sb sh se ang  old_osmode); (setq old_osmode (getvar "OSMODE"))
(setq ps1 (getpoint "\Chon diem thu nhat: "))
(setq ps2 (getpoint ps1 "\nChon diem tiep theo: "))
(setq sb 100.0 sh 250.0 se 20.0)
(setq ang (angle ps1 ps2))
(setq pf1 (polar ps1 ang (- 0.0 se)))
(setq pf2 (polar ps1 ang (/ (- (distance ps1 ps2) sb) 2.0) ))
(setq pf3 (polar pf2 (+ ang (/ pi 2)) (/ sh 2.0)))
(setq pf5 (polar pf2 ang sb))
(setq pf4 (polar pf5 (- ang (/ pi 2)) (/ sh 2.0)))
(setq pf6 (polar ps2 ang se))
(setvar "OSMODE" 0)
(setvar "BLIPMODE" 0)
(command "PLINE" pf1 pf2 pf3 pf4 pf5 pf6 "")
(setvar "OSMODE" 703)
(princ) )

;==================================================================================
(defun c:ang (/ ent pt1 pt2 ang)
(setq cmd (getvar "cmdecho"))
  (setvar "cmdecho" 1)
  (prompt (strcat"\nThay doi truc toa do theo duong thang chon truoc"))
  (setq ent (entsel "\nChon duong thang:"))
  (if ent
(progn
(setq ent (entget (car ent)))
(setq pt1 (cdr (assoc 10 ent)))
(setq pt2 (cdr (assoc 11 ent)))
(setq ang (angle pt1 pt2))
(setq ang (/ (* ang 180.0) pi))
(setvar "cmdecho" 0)
(command "setvar" "snapang" ang)
(princ "\nGoc cua truc toa do moi : ")
(princ ang)
)
  )
  (setvar "cmdecho" cmd)
  (princ)
)
;==================================================================================
;============================== KY HIEU DOI XUNG ==============================
;==================================================================================

(DEFUN C:DX (/ CMD OSM OLDERR PT1 PT2 PT3 PT4 PT5 PT6 PT7 PT8 PT9
            SZ G45 G135 G90 G180 SS loi)
(defun loi (s)
(if (= s "Function cancelled")
   (princ)
   (princ (strcat "Error:" s))
)
      (SETVAR "CMDECHO" CMD)
      (SETVAR "OSMODE" OSM)
      (SETQ *error* OLDERR)
      (PRINC)
)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETVAR "CMDECHO" 0)
(SETQ OLDERR *error*
      *error* loi)
(SETQ SZ (GETREAL "Size <1>:"))
(IF (= SZ nil) (SETQ SZ 100))
(SETQ G45 (/ PI 4))
(SETQ G135 (* 3 (/ PI 4)))
(SETQ G90 (- G45 (/ PI 2)))
(SETQ G180 (+ G135 (/ PI 2)))
(SETQ PT1 (GETPOINT "\nDiem doi xung:"))
(SETVAR "OSMODE" 0)
(SETQ PT2 (POLAR PT1 G45 (* 2 SZ)))
(SETQ PT3 (POLAR PT2 G90 (* 2 SZ)))
(SETQ PT4 (POLAR PT1 G45 (* 1 SZ)))
(SETQ PT5 (POLAR PT1 G135 (* 2 SZ)))
(SETQ PT6 (POLAR PT5 G180 (* 2 SZ)))
(SETQ PT7 (POLAR PT1 G135 (* 1 SZ)))
(SETQ PT8 (POLAR PT1 G45 (* -0.7 SZ)))
(SETQ PT9 (POLAR PT1 G135 (* -0.7 SZ)))
(PRINC "\nGoc quay:")
(SETQ SS (SSADD))
(command "layer" "m" "Dim" "c" "" """")
(COMMAND "COLOR" "1" "")
(COMMAND "LINE" PT8 PT2 "")
(SETQ SS (SSADD (ENTLAST) SS))
(COMMAND "LINE" PT9 PT5 "")
(SETQ SS (SSADD (ENTLAST) SS))
(COMMAND "COLOR" "1" "")
(COMMAND "SOLID" PT2 PT3 PT4 "" "")
(SETQ SS (SSADD (ENTLAST) SS))
(COMMAND "SOLID" PT5 PT6 PT7 "" "")
(SETQ SS (SSADD (ENTLAST) SS))
(COMMAND "ROTATE" SS "" PT1 PAUSE)
(COMMAND "COLOR" "BYLAYER" "")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(SETQ *error* OLDERR)
(PRINC)
)

;==================================================================================
;================================= KY HIEU TRUC ===============================
;==================================================================================

(defun C:vetruc ()
(setq bk (getvar "USERR3"))
(if (= bk 0)
  (progn
(setq cont "1")
(setvar "USERR3" 1)
)
      (setq cont (rtos bk))
)
(setq pt1 (getpoint "\n Nhap diem dat:"))
(command "layer" "m" "Dim" "c" "" """")
(command "osnap"  "")
(COMMAND "COLOR" "7" "")
(command "circle" pt1 150 "")
(setq pt2 (polar pt1 0 150))
(setq pt3 (polar pt1 (/ pi 1) 150))
(setq pt4 (polar pt1 0 300))
(setq pt5 (polar pt1 (/ pi 1) 300))
(setq pt6 (polar pt1 (- 0 (/ pi 2)) 150))
(setq pt7 (polar pt1 (- 0 (/ pi 2)) 300))
(setq pt8 (polar pt1 (/ pi 2) 150))
(setq pt9 (polar pt1 (/ pi 2) 300))
(setq pt10 (polar pt1 0 150))
(setq pt11 (polar pt1 (/ pi 4) 150))
(COMMAND "COLOR" "BYLAYER" "")
(command "line" pt2 pt4 "")
(command "line" pt6 pt7 "")
(command "line" pt3 pt5 "")
(command "line" pt8 pt9 "")
(setq dk (strcat "\n Size:<"cont">"))
(setq bk (getreal dk))
(if (= bk nil)
(progn
  (setq bk (getvar "USERR3"))
      )
  (setvar "USERR3" bk)
  )
(command "scale" pt4 pt5 pt7 pt9 pt11"" pt1 bk"")
(COMMAND "COLOR" "7" "")
(COMMAND "STYLE" "Truc"  "impact" "" "" "" "" "")
(command "text" "j" "mc" pt1 (* 150 bk) pt10 "A" "")
(COMMAND "COLOR" "BYLAYER" "")
)

;=====================================================================
;CA - Reverses the case of text.  (Upper to Lower and Lower to Upper.)
;
;Jeffery P Sanders
;
(defun C:CA(/ en enlist tx newtx cnt tp asc note)
(setvar "cmdecho" 0)
(if(setq en(entsel))
(progn
   (setq enlist(entget(car en)))
   (if(= "TEXT"(cdr(assoc 0 enlist)))
      (progn
      (setq tx(cdr(assoc 1 enlist))
         newtx "" cnt(strlen tx)
            note "\n...CASE Reversed. \n "
      )
      (while (> cnt 0)
         (setq tp(substr tx cnt 1))
         (setq asc(ascii tp))
         (if (> asc 96)
            (setq tp(strcase tp))
            (setq tp(strcase tp T))
         )
         (setq newtx(strcat tp newtx))
         (setq cnt(- cnt 1))
      )
      (setq enlist(subst(cons 1 newtx)(assoc 1 enlist)enlist))
      (entmod enlist)
      )
      (setq note "\n....Text Only Please. \n ")
   )
)
(setq note "\n....Nothing Selected. \n ")
  )
  (setvar "cmdecho" 1)
  (princ note)
  (princ)
)

;=====================================================================
;==================== NEW TEXT STYLE UPDATE ==========================
;=====================================================================

(defun c:nS (/ tdt ssdt sodt index)
(defun ObjName (ssdt /)
(cdr (assoc '0 (entget ssdt)))
)
(defun MoPL (ssdt /)
(= (cdr (assoc '70 (entget ssdt))) 0)
)
(defun NoiPL (ssdt /)
(if (MoPL ssdt)
(command ".PEDIT" ssdt "J" "All" "" "X")
)
)
(defun NoiLC (ssdt /)
(command ".PEDIT" ssdt "Y" "J" "All" "" "X")
)
(setq
tdt (ssget)
sodt (sslength tdt)
index 0
)
(repeat sodt
(setq
ssdt (ssname tdt index)
index (1+ index)
)
(if (or (= (Objname ssdt) "LWPOLYLINE")
(= (Objname ssdt) "POLYLINE")
)
(NoiPL ssdt)
)
(if (or (= (Objname ssdt) "LINE") (= (Objname ssdt) "ARC"))
(NoiLC ssdt)
)
)
(princ)
)

;=====================================================================
;;; AREAM.LSP
;;; Function: Calculates the total area of selected objects
;;; By Jimmy Bergmark
;;; Copyright (C) 1997-2006 JTB World, All Rights Reserved
;;; Tested on AutoCAD 2000

(defun c:ea (/ olderr oldcmdecho errexit undox restore ss1 nr en tot_area)
  (defun errexit (s)
(restore)
  )

  (defun undox ()
(command "._undo" "_E")
(setvar "cmdecho" oldcmdecho)
(setq *error* olderr)
(princ)
  )

  (setq olderr  *error*
      restore undox
      *error* errexit
  )
  (setq oldcmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "._UNDO" "_BE")
  (if (setq ss1 (ssget '((-4 . "<OR")
                     (0 . "POLYLINE")
                     (0 . "LWPOLYLINE")
                     (0 . "CIRCLE")
                     (0 . "ELLIPSE")
                     (0 . "SPLINE")
                     (0 . "REGION")
                     (-4 . "OR>")
                     )
            )
   )
(progn
   (setq nr 0)
   (setq tot_area 0.0)
   (setq en (ssname ss1 nr))
   (while en
      (command "._area" "_O" en)
      (setq tot_area (+ tot_area (getvar "area")))
      (setq nr (1+ nr))
      (setq en (ssname ss1 nr))
   )
   (princ "\nTotal Area = ")
   (princ tot_area)
)
  )
  (restore)
)

;=====================================================================
;;; By Jimmy Bergmark
;;; Copyright (C) 2008 JTB World, All Rights Reserved
;;;
;;; Created: 2008-03-31
;;;
;;; Convert Attribute definitions to mtext
;;;

(defun c:ATB (/ eset1 blkcnt en enlist tag1 ht pnt vl space)
  (setq       eset1  (ssget (list (cons 0 "ATTDEF")))
      blkcnt 0
  )

  (if eset1
(while (<= blkcnt (- (sslength eset1) 1))
   (setq en          (ssname eset1 blkcnt)
         enlist (entget en)
         ht          (cdr (assoc 40 enlist))
         pnt          (assoc 10 enlist)
         pnt          (subst (+ ht (caddr pnt)) (caddr pnt) pnt)
         space  (cdr (assoc 67 enlist))
   )
   (setq vl (list
               (cons 0 "MTEXT")
               (cons 100 "AcDbEntity")
               (cons 100 "AcDbMText")
               (assoc 7 enlist)
               (assoc 8 enlist)
               pnt
               (assoc 40 enlist)
               (cond ((assoc 62 enlist))
                     ((cons 62 256))
               )
               (cons 1 (cdr (assoc 2 enlist)))
               (if (= space nil)
               (cons 67 0)
               (cons 67 space)
               )
            )
   )
   (entdel en)
   (entmake vl)
   (setq blkcnt (1+ blkcnt))
)
  )
)

;=====================================================================

(defun c:xxx ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
(princ "\nCopy Inteligent...\n")
(setq       luuecho       (getvar       "cmdecho")
      luu       *error*
      *error*       ketthuc
      cumdt       (ssget)
      dodai       (sslength cumdt)
      goc             (getpoint "\nSelect base point:")
      thoat             nil
      dem             0
      textxl             nil
);
(setvar "cmdecho" 0)
; Loc ra duoc ong text de xu ly
(while       (and       (= thoat       nil)
            (< dem       dodai)
      )
      (setq       ten       (ssname cumdt dem)
            dem       (1+       dem)
            doituong (entget ten)
            kieu       (cdr (assoc       0       doituong))
      )

      (if (or (= kieu             "TEXT")
            (= kieu       "MTEXT")
            )
            (setq       thoat       T
                     textxl       (cdr (assoc 1 doituong))
            )
      )
);
(while T
(setq       toi             (getpoint "\nSelect next point: " goc)
      vitrilech       (list       (- (car toi) (car goc)) (- (nth 1 toi) (nth 1 goc)))
      dem             0
)
(while       (< dem dodai)
      (setq       ten       (ssname cumdt dem)
            dem       (1+       dem)
            doituong (entget ten)
            kieu       (cdr (assoc       0       doituong))
      )

      (if (or (= kieu             "TEXT")
            (= kieu       "MTEXT")
            )
            (doitext       ten)
            (copy_dt       ten)

      );if
)
);while
(ketthuc)
);defun
(princ)

;=====================================================================
;;; By Jimmy Bergmark
;;; Copyright (C) 2008 JTB World, All Rights Reserved
;;;
;;; Created: 2008-03-31
;;;
;;; Convert Attribute definitions to text
;;;

(defun c:ATT (/ eset1 blkcnt en enlist vl space)
  (setq       eset1  (ssget (list (cons 0 "ATTDEF")))
      blkcnt 0
  )

  (if eset1
(while (<= blkcnt (- (sslength eset1) 1))
   (setq en          (ssname eset1 blkcnt)
         enlist (entget en)
         space  (cdr (assoc 67 enlist))
   )
   (setq vl (list
               (cons 0 "TEXT")
               (cons 100 "AcDbEntity")
               (cons 100 "AcDbText")
               (assoc 7 enlist)
               (assoc 8 enlist)
               (assoc 10 enlist)
               (assoc 40 enlist)
               (cond ((assoc 62 enlist))
                     ((cons 62 256))
               )
               (cons 1 (cdr (assoc 2 enlist)))
               (if (= space nil)
               (cons 67 0)
               (cons 67 space)
               )
            )
   )
   (entdel en)
   (entmake vl)
   (setq blkcnt (1+ blkcnt))
)
  )
)
;=====================================================================
;============================ Doi Truc ===============================
;=====================================================================

;=====================================================================
;=============== FUNCTIONS GA 1+3+5+7+9+11+13+15+17+19 ===============
;======================== Tran Ngoc Thang ============================
(defun c:ga1 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".circle" c a)
(command ".line" a c "")
(command ".array" "last" "" "p" c "1" "" "")
(princ))

(defun c:ga3 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".circle" c a)
(command ".line" a c "")
(command ".array" "last" "" "p" c "3" "" "")
(princ))

(defun c:ga5 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".circle" c a)
(command ".line" a c "")
(command ".array" "last" "" "p" c "5" "" "")
(princ))

(defun c:ga7 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".circle" c a)
(command ".line" a c "")
(command ".array" "last" "" "p" c "7" "" "")
(princ))

(defun c:ga9 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".circle" c a)
(command ".line" a c "")
(command ".array" "last" "" "p" c "9" "" "")
(princ))

(defun c:ga11 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".circle" c a)
(command ".line" a c "")
(command ".array" "last" "" "p" c "11" "" "")
(princ))

(defun c:ga13 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".circle" c a)
(command ".line" a c "")
(command ".array" "last" "" "p" c "13" "" "")
(princ))

(defun c:ga15 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".circle" c a)
(command ".line" a c "")
(command ".array" "last" "" "p" c "15" "" "")
(princ))

(defun c:ga17 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".circle" c a)
(command ".line" a c "")
(command ".array" "last" "" "p" c "17" "" "")
(princ))

(defun c:ga19 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".circle" c a)
(command ".line" a c "")
(command ".array" "last" "" "p" c "19" "" "")
(princ))

;=====================================================================
;============== FUNCTIONS GA 2+4+6+8+10+12+14+16+18+20 ===============
;;;=============== Tran Ngoc Thang - Sinh 03-05-1976 =================
(defun c:ga2 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".line" a c "")
(command ".array" "last" "" "p" c "2" "" "")
(command ".circle" c a)
(princ))

(defun c:ga4 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".line" a c "")
(command ".array" "last" "" "p" c "4" "" "")
(command ".circle" c a)
(princ))

(defun c:ga6 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".line" a c "")
(command ".array" "last" "" "p" c "6" "" "")
(command ".circle" c a)
(princ))

(defun c:ga8 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".line" a c "")
(command ".array" "last" "" "p" c "8" "" "")
(command ".circle" c a)
(princ))

(defun c:ga10 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".line" a c "")
(command ".array" "last" "" "p" c "10" "" "")
(command ".circle" c a)
(princ))

(defun c:ga12 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".line" a c "")
(command ".array" "last" "" "p" c "12" "" "")
(command ".circle" c a)
(princ))

(defun c:ga14 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".line" a c "")
(command ".array" "last" "" "p" c "14" "" "")
(command ".circle" c a)
(princ))

(defun c:ga16 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".line" a c "")
(command ".array" "last" "" "p" c "16" "" "")
(command ".circle" c a)
(princ))

(defun c:ga18 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".line" a c "")
(command ".array" "last" "" "p" c "18" "" "")
(command ".circle" c a)
(princ))

(defun c:ga20 ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".line" a c "")
(command ".array" "last" "" "p" c "20" "" "")
(command ".circle" c a)
(princ))

;=====================================================================
;============== FUNCTIONS GA TUY THICH : EVERYTHING IF ===============
;========================== 06-11-2016 ~ 18h00 =======================
;;;=============== Tran Ngoc Thang - Sinh 03-05-1976 =================
(defun c:ga ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".circle" c a)
(command ".line" a c "")
(command ".array" "last" "" "p" c "NUM" "" "")
(princ))

;=====================================================================
;=========== FUNCTIONS HOA THI TUY THICH : EVERYTHING IF =============
;========================== 06-11-2016 ~ 18h40 =======================
;;;=============== Tran Ngoc Thang - Sinh 03-05-1976 =================

(defun c:hoathi ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".line" a c "")
(command ".array" "last" "" "p" c "NUM" "" "")
(princ))

;=====================================================================
;============= FUNCTIONS CUNG TUY THICH : EVERYTHING IF ==============
;========================== 03-11-2024 ~ 19h33 =======================
;;;=============== Tran Ngoc Thang - Sinh 03-05-1976 =================

(defun c:cung ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (getpoint a"\nChon diem: "))
(setq d (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".arc" a b c "")
(command ".array" "last" "" "p" c "NUM" "" "")
(princ))

;=====================================================================
;============ FUNCTIONS HECLOIC TUY THICH : EVERYTHING IF ============
;========================== 03-11-2024 ~ 20h02 =======================
;;;=============== Tran Ngoc Thang - Sinh 03-05-1976 =================
(defun c:hecloic ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: multi "))
(setq c (getpoint a"\nChon diem: "))(princ)
(setq d (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".arc" a b c "")
(command ".array" "last" "" "p" c "NUM" "" "")
(princ))

;=====================================================================
;============== FUNCTIONS GAY TUY THICH : EVERYTHING IF ==============
;========================== 03-11-2024 ~ 19h38 =======================
;;;=============== Tran Ngoc Thang - Sinh 03-05-1976 =================

(defun c:gay ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: "))
(setq c (getpoint a"\nChon diem: "))(princ)
(setq d (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".pline" a b c "")
(command ".array" "last" "" "p" c "NUM" "" "")
(princ))

;=====================================================================
;============ FUNCTIONS HECLOIT TUY THICH : EVERYTHING IF ============
;========================== 03-11-2024 ~ 20h02 =======================
;;;=============== Tran Ngoc Thang - Sinh 03-05-1976 =================

(defun c:hecloit ()
(setq a (getpoint "\nChon diem: "))
(setq b (getpoint a"\nChon diem: multi "))
(setq c (getpoint a"\nChon diem: "))(princ)
(setq d (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
(command ".pline" a b c "")
(command ".array" "last" "" "p" c "NUM" "" "")
(princ))

;;; ============================ Merge Hatch =============================

(defun c:mh (/ ss entht sl i dt dtht)

  (princ "\nMerge Hatch - free lisp from CADViet.com")

  (setq
ss (ssget '((0 . "HATCH")))
sl (if ss
      (sslength ss)
      0
   )
i  0
l  0
  )

  (repeat sl
(setq
   entht (ssname ss i)
   dtht  (getbdata entht)
   dt (append dt dtht)
   l          (+ l (cdr (assoc 91 (entget entht))))
   i          (1+ i)
)
  )

  (setq       ent  (ssname ss 0)
      ss (ssdel ent ss)
      tt (entget ent)
      duoi (member (assoc 75 tt) tt)
      dau  (reverse (member (assoc 91 tt) (reverse tt)))
      tt (append dau dt duoi)
      tt (subst (cons 91 l) (assoc 91 tt) tt)
  )
  (entmod tt)

  (command ".erase" ss "")
  (princ)
)

(defun getbdata       (ent)
  (setq       tt (entget ent)
      tt (cdr (member (assoc 75 tt) (reverse tt)))
      tt (cdr (member (assoc 91 tt) (reverse tt)))
  )
)

(princ)

;;; =========================== CAC LENH LAYER ==============================
;;; =========================== Layer hien hanh =============================

(defun layset (/ LAY) (setvar "cmdecho" 0)
(setq LAY (entsel "\nPick vao doi tuong muon Layer hien hanh la Layer cua doi tuong do : "))
(if LAY    (progn
  (setq LAY (cdr (assoc 8 (entget (car LAY)))))
  (command "_.layer" "set" LAY "") (princ (strcat "\nLayer : " LAY " da la hien hanh."))  )
         (progn
   (if (not ddlop) (load "ddlop"))  (if (setq LAY (ddlop))
         (progn
         (command "_.LAYER" "ON" LAY "THAW" LAY "SET" LAY "")  (princ (strcat "\nLayer : " LAY " da la hien hanh.")) ) ) ) )(princ) )
(defun c

LL () (layset))(defun c

AYSET () (layset))

;;; ================== Cap nhat doi tuong vao layer hien hanh ==================

(Defun LAYCUR (/ SS CNT LAY)  (setvar "cmdecho" 0)
  (if (not (setq SS (ssget "i")))
(progn (prompt "\nChon doi tuong cap nhat vao layer hien hanh: ")
   (setq SS (ssget)) )  )
  (if SS (progn
(setq CNT (sslength SS)) (princ (strcat "\n" (itoa CNT) " doi tuong tim thay."))                (command "_.move" SS "")
   (if (> (getvar "cmdactive") 0)
      (progn
      (command "0,0" "0,0") (setq SS  (ssget "p") CNT (- CNT (sslength SS)) ) )
      (setq SS nil)    )  (if (> CNT 0)
      (princ (strcat "\n" (itoa CNT) " doi tuong tren layer LOCK.")) ) ) )
  (if SS (progn
   (setq LAY (getvar "CLAYER")) (command "_.chprop" SS "" "_la" LAY "")
   (if (= (sslength SS) 1)
      (prompt (strcat "\n1 doi tuong da cap nhat vao layer : " LAY " (layer hien hanh)."))
      (prompt (strcat "\n" (itoa (sslength SS)) " doi tuong da cap nhat vao layer : " LAY " (layer hien hanh).")) ) ))  (princ) );end
(defun c

AYCUR () (laycur)) (defun c

HH () (laycur))

;;; =========================== Layer Iso ===================================

(Defun LAYISO (/ SS CNT LAY LAYLST VAL)  (setvar "cmdecho" 0)
  (if (not (setq SS (ssget "i"))) (progn
   (prompt "\nChon doi tuong tren layer(s) muon lam viec doc lap: ")
   (setq SS (ssget)) )  )
  (if SS (progn    (setq CNT 0)
   (while (setq LAY (ssname SS CNT))
      (setq LAY (cdr (assoc 8 (entget LAY))))
      (if (not (member LAY LAYLST))
      (setq LAYLST (cons LAY LAYLST))       )
      (setq CNT (1+ CNT))    )
   (if (member (getvar "CLAYER") LAYLST)
      (setq LAY (getvar "CLAYER"))
      (setvar "CLAYER" (setq LAY (last LAYLST)))    )
   (command "_.LAYER" "_OFF" "*" "_Y")
   (foreach VAL LAYLST (command "_ON" VAL))
   (command "")          (if (= (length LAYLST) 1)
      (prompt (strcat "\nLayer " (car LAYLST) " da tach ra."))
      (prompt (strcat "\n" (itoa (length LAYLST)) " layers da tach ra. "
                     "Layer " LAY " la hien hanh." )  )  )  )  )  (princ) )
(defun c

AYISO () (layiso)) (defun c

I () (layiso))

;;; =========================  Layer Match ==================================

(Defun LAYMCH (/ SS CNT LOOP LAY ANS)
  (setvar "cmdecho" 0)
  (if (not (setq SS (ssget "i"))) (progn
   (prompt "\nChon doi tuong muon thay doi Layer : ")
   (setq SS (ssget)) )  )
  (if SS (progn
   (setq CNT (sslength SS))
   (princ (strcat "\n" (itoa CNT) " found."))  (command "_.move" SS "")
   (if (> (getvar "cmdactive") 0) (progn
      (command "0,0" "0,0")  (setq SS  (ssget "p")
            CNT (- CNT (sslength SS)) ) )
      (setq SS nil)    )  (if (> CNT 0)
      (princ (strcat "\n" (itoa CNT) " tren layer LOCK.")) ) )  )
  (if SS (progn
   (initget "Ten")  (setq LAY  (entsel "\nTen layer/<Pick doi tuong>: ")  LOOP T  )
(while LOOP       (cond
      ((not LAY)
         (prompt "\nKhong chon doi tuong.")
         (prompt "\nSu dung layer hien hanh? <Y> ")
         (setq ANS (strcase (getstring)))
         (if (or (= ANS "") (= ANS "Y") (= ANS "YES"))
            (setq LAY  (getvar "clayer")  LOOP nil )  )  )
      ((listp LAY)  (setq LOOP nil) )
      ((= LAY "Ten")
         (setq LAY (getstring "\n>Nhap ten layer: "))
         (cond
            ((tblsearch "LAYER" LAY)  (setq LOOP nil) )
            ((/= LAY "")
            (prompt "\nLayer chua co trong ban ve. Tao layer moi? <Y>: ")
            (setq ANS (strcase (getstring)))
            (if (or (= ANS "") (= ANS "Y") (= ANS "YES"))
                  (progn
                     (command "_.LAYER" "NEW" LAY "")
                     (setq LOOP nil) )
                  (prompt "\nLoi ten layer.") ) )  )  ) )
      (if LOOP  (progn (initget "Ten")
         (setq LAY  (entsel "\nTen layer/<Pick doi tuong>: ")) ) ) ); while LOOP
      (if (listp LAY)
      (setq LAY (cdr (assoc 8 (entget (car LAY)))))    )
   (command "_.chprop" SS "" "_la" LAY "")
   (if SS  (prompt (strcat "\n" (itoa (sslength SS)) " doi tuong thay doi toi layer " LAY )) )
   (if (= LAY (getvar "clayer"))
      (prompt " (layer hien hanh).")  (prompt ".") ) ) )  (princ) )
(defun c

AYMCH () (laymch)) (defun c:CLL () (laymch))

;;; ============================ Layer OFF =================================

(DEFUN C

J (/ SSET SSL ENT LAY I MODE)
(SETQ SSET (SSGET))
(IF (/= NIL SSET)
(PROGN
   (SETQ SSL (SSLENGTH SSET))
   (SETQ LAY "")
   (SETQ I 0)
   (SETQ MODE 0)
   (WHILE (< I SSL)
               (SETQ ENT (ENTGET (SSNAME SSET I)))
      (IF (= (CDR (ASSOC '8 ENT)) (GETVAR "CLAYER")) (SETQ MODE 1) )
      (SETQ LAY (STRCAT LAY "," (CDR (ASSOC '8 ENT)) ))
      (SETQ I (+ I 1))
   )
   (COMMAND "LAYER" "OFF" LAY "")
   (IF (= MODE 1) (COMMAND "") )
)
)
(PRINC)
)

;;; ================================ Layer ON ==============================

(Defun LAYON ()  (setvar "cmdecho" 0)
(setq Lay loff1) (setq Loff1 Loff2) (setq Loff2 Loff3) (setq Loff3 Loff4) (setq Loff4 Loff5) (setq Loff5 Loff6) (setq Loff6 "0")
  (Command "LAYER" "ON" Lay "") (princ (strcat "\n    Layer : " LAY " da ON."))  (princ))
(defun c

AYON () (layon)) (defun c:LOO () (layon))
(Defun C:LO () (setvar "cmdecho" 0)  (Command "_.LAYER" "_ON" "*" "") (princ "\nDa ON toan bo cac Layer !") (princ))

;;; ============================== Layer Freeze ===========================

(Defun LAYFRZ (/ LAY TEMP)(setvar "cmdecho" 0)
(prompt "\nChon doi tuong tren layer(s) muon FREEZE: ") (SETQ SSET (SSGET))
(IF (/= NIL SSET) (PROGN
   (SETQ SSL (SSLENGTH SSET))  (SETQ LAY "") (SETQ I 0) (SETQ MODE 0)
   (WHILE (< I SSL)
   (SETQ ENT (ENTGET (SSNAME SSET I)))
   (IF (= (CDR (ASSOC '8 ENT)) (GETVAR "CLAYER")) (SETQ MODE 1) )
   (SETQ LAY (STRCAT LAY "," (CDR (ASSOC '8 ENT)) )) (SETQ I (+ I 1)))
   (COMMAND "LAYER" "FREEZE" LAY "")
   (IF (= MODE 1) (COMMAND ""))))
(setq Lff6 Lff5) (setq Lff5 Lff4) (setq Lff4 Lff3) (setq Lff3 Lff2) (setq Lff2 Lff1) (setq Lff1 LAY)
(princ (strcat "\n    Layer " LAY " da FREEZE."))(setvar "cmdecho" 1) (princ) )
(defun c:LAYFRZ () (layfrz)) (defun c:LLF    () (layfrz))

;;; ============================== Layer Thaw ===============================

(Defun LAYTHW ()
  (setvar "cmdecho" 0)
(setq Lay lff1) (setq Lff1 Lff2) (setq Lff2 Lff3) (setq Lff3 Lff4) (setq Lff4 Lff5) (setq Lff5 Lff6) (setq Lff6 "0")
  (Command "_.LAYER" "_THAW" LAY "")
         (princ (strcat "\n    Layer : " LAY " da THAW."))
         (princ) )
(defun c:LAYTHW () (laythw)) (defun c:LW () (laythw))

;;; ============================== Layer Lock ==============================

(Defun LAYLCK (/ LAY)
  (setvar "cmdecho" 0)
  (setq LAY (entsel "\n>Pick doi tuong tren layer muon LOCK: "))
  (if LAY
(progn
   (setq LAY (cdr (assoc 8 (entget (car LAY)))))
   (Command "_.LAYER" "_LOCK" LAY "")
   (princ (strcat "\nLayer " LAY " da LOCK.")) )  )  (princ) )
(defun c:LAYLCK () (laylck)) (defun c:LK    () (laylck))

;;; ============================== Layer UnLock ==============================

(Defun LAYULK (/ LAY)
  (setvar "cmdecho" 0)
  (setq LAY (entsel "\n>Pick doi tuong tren layer muon UNLOCK: "))
  (if LAY
(progn
   (setq LAY (cdr (assoc 8 (entget (car LAY)))))
   (Command "_.LAYER" "_UNLOCK" LAY "")
   (princ (strcat "\nLayer " LAY " da UNLOCK.")) )  )  (princ) )
(defun c:LAYULK () (layulk)) (defun c:LU () (layulk))

;;;===================== Delete all objects of Layer ========================

(defun DELAYER (/ ocmd L S)
  (setq ocmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq L (strcase (getstring "\nLayer(s) to delete: ")))
  (setq S (ssget "X" (list (cons 8 L))))
  (if S
(command "ERASE" S "")
(princ "Layer empty or not a valid layer name.")  )
  (setq S nil)
  (setvar "CMDECHO" ocmd)
  (princ) )
(defun c:DELAYER  () (delayer)) (defun c:DELLAYER () (delayer)) (defun c:DEL    () (delayer))

;;; ========================= HET CAC LENH LAYER ===========================

;;;====================== EXTEND NHIEU DOI TUONG ===========================

(Defun C:EET ()
  (Setq CVAR (Getvar "CMDECHO"))  (Setvar "CMDECHO" 0)
  (Prompt "Chon doi tuong dich cua EXTEND :")  (Setq CUTEDG (Ssget))
  (Prompt "Chon doi tuong de Extend :")  (Setq SS (SSget))  (Setq LEN (SSlength SS))
  (Setq I -1)
  (Setq SIDE (getpoint"Chon phia de EXTEND"))  (Command "EXTEND" CUTEDG "")
  (Repeat LEN
(Setq I (1+ I))
(Command (List(SSname SS I) SIDE))  )  (Command "")
  (Setvar "CMDECHO" CVAR)  (Princ "Da Extend xong moi ban lam tiep")  (Princ) )

;;; ===============  EXTEND 1 DOI TUONG THEO KHOANG CACH ===============

(defun c:ETT ()  (setq os (getvar "osmode"))  (setvar "osmode" 512)
  (setq pt1 (getpoint "\nKich vao 1 dau doan thang can EXTEND  "))
  (setvar "osmode" os)
  (setq dis (getdist pt1 "\nKhoang cach can EXTEND :"))
  (command "circle" "endpoint" pt1 dis)  (command "extend" "last" "" pt1 "")  (command "erase" "last" "") (princ))

;; ================ Change width of polylines =========================

(DEFUN wp (/ a b sophantu sodem list1 ha:wid)
(PRINC "\n       Chon doi tuong can thay doi do day (Width) !")
(setq b (ssget))
(setq sophantu (sslength b))
(if (null ha:wid) (setq ha:wid (getvar "tracewid")))
(princ "\nDo rong polyline <")
(princ ha:wid)
(princ ">: ")
(initget 4)
(setq ha:wid (getdist))
(if (null ha:wid) (setq ha:wid (getvar "tracewid")))
(setvar "tracewid" ha:wid)
(setvar "cmdecho" 0)
(setq sodem 0)
(repeat sophantu
  (setq a (ssname b sodem))
  (setq list1 (assoc 0 (entget a)))
(cond
   ((= (cdr list1) "POLYLINE") (command "_Pedit" a "w" ha:wid ""))
   (PROGN (command "_Pedit" a "" "w" ha:wid "")) )
(setq sodem (1+ sodem)) )(SETVAR "cmdecho" 1)(princ))
(defun c:wp () (wp)) (defun c:pw () (wp))

;; ================ Change radius of circles ==========================

(DEFUN C:CHR (/ SSET SSL M RD I) (PRINC "\nSelect Circles :") (SETQ SSET (SSGET))
(IF (/= NIL SSET) (PROGN  (SETQ SSL (SSLENGTH SSET))  (INITGET 4 "")  (SETQ RD (GETDIST "\nNew radius : "))
(IF (/= RD NIL)  (PROGN (SETQ I 0)
(WHILE (< I SSL) (SETQ M (ENTGET (SSNAME SSET I) ) )
(IF (= (CDR (ASSOC '0 M)) "CIRCLE") (PROGN
  (SETQ M (SUBST (CONS 40 RD) (ASSOC 40 M) M))  (ENTMOD M) ) )  (SETQ I (+ I 1)) )    ) ))) (PRINC) )

;;; ============================== TEXT Hight ===============================

(defun texthght (/ ent hght)
  (setvar "cmdecho" 1)
  (prompt (strcat"\nSelect text entity with required text height"))
  (prompt (strcat"\n."))
  (setq ent (entget (car (entsel))))
  (setq hght (cdr (assoc 40 ent)))
  (prompt (strcat"\nText height now set at "))(prin1 hght)
  (prompt (strcat"\n."))
(setvar "cmdecho" 1)
(command "DTEXT" PAUSE hght "") )
(defun c:teh () (texthght))  (defun c:texthght () (texthght))

;;; ================ BAT -TAT CHE DO GACH CHAN TEXT =================

(defun c:tuu ()  (setvar "cmdecho" 0)
(prompt "\nHay chon dong TEXT can gach chan ")
(prompt "\nSelect objects: ")
(command "select" "au" pause)
(setq sstxt (ssget "p")
      sslen (sslength sstxt)
      ctr 0 )
(command ".undo" "mark")
(while (< ctr sslen)
         (setq listxt (entget (ssname sstxt ctr))
               txttxt (cdr (assoc 1 listxt))
               enttxt (cdr (assoc 0 listxt)) )
         (if (= enttxt "TEXT")
            (progn
               (setq testxt (substr txttxt 1 3))
               (if (or (= testxt "%%u") (= testxt "%%U"))
                     (setq newtxt (substr txttxt 4))
                     (setq newtxt (strcat "%%u" txttxt)) )
               (setq listxt (subst (cons 1 newtxt) (assoc 1 listxt) listxt))
               (entmod listxt)             ) )
         (setq ctr (1+ ctr))  ) (setvar "cmdecho" 1) (princ))

;;; ================ BAT -TAT CHE DO GACH CHAN TEXT =================

(defun c:tob ()  (setvar "cmdecho" 0)
(prompt "\nHay chon dong TEXT can gach tren dau ")
(prompt "\nSelect objects: ")
(command "select" "au" pause)
(setq sstxt (ssget "p")
      sslen (sslength sstxt)
      ctr 0 )
(command ".undo" "mark")
(while (< ctr sslen)
         (setq listxt (entget (ssname sstxt ctr))
               txttxt (cdr (assoc 1 listxt))
               enttxt (cdr (assoc 0 listxt)) )
         (if (= enttxt "TEXT")
            (progn
               (setq testxt (substr txttxt 1 3))
               (if (or (= testxt "%%o") (= testxt "%%o"))
                     (setq newtxt (substr txttxt 4))
                     (setq newtxt (strcat "%%o" txttxt)) )
               (setq listxt (subst (cons 1 newtxt) (assoc 1 listxt) listxt))
               (entmod listxt)             ) )
         (setq ctr (1+ ctr))  ) (setvar "cmdecho" 1) (princ))

;;; ========================== Tim & thay the TEXT ==========================

(defun frstring (str search replace / str1 str2 index find)
(setq index 0) (while  (<= index (- (strlen str) (strlen search)))  (setq index (1+ index))
(setq find (substr str index (strlen search)))  (if (= find search) (progn (setq str1 (substr str 1 (1- index)))
(setq str2 (substr str (+ index (strlen search))))  (setq str (strcat str1 replace str2)) )  ) ) (setq str str))
(defun hai (/ dial)
(setq dial (load_dialog "hai.dcl"))    ;;goi dialog
(if (not (new_dialog "find" Dial)) (exit)) ;;
(mode_tile "find" 2); Tao dau nhac tai hop thoai
(action_tile "find" "(hai1)")
(action_tile "replace" "(hai2)")
(action_tile "cancel" "(done_dialog) (exit)")
(start_dialog)
(unload_dialog dial))
(defun hai1 () (SETQ str1 (get_tile "find")))
(defun hai2 () (SETQ str2 (get_tile "replace")))

(defun c:TTT (/ a str str1 str2 newstr taphop sodem)
(hai)
(if (or (null str1) (null str2)) (princ "\nDu lieu khong hop le")
  (progn
(setq taphop (ssget '((0 . "TEXT"))))
(setq sodem 0)
(if taphop
(progn
   (Repeat (sslength taphop)
   (setq a (entget (ssname taphop sodem)))
   (setq str (cdr (assoc 1 a)))
   (setq newstr (frstring str str1 str2))
   (setq a (subst (cons 1 newstr) (assoc 1 a) a))
   (entmod a)
   (setq sodem (1+ sodem))    ) )
(princ "\nNone "TEXT" selected") )  ) ) (setq *error* olderr) (princ))

;;;=============================  CHTEXSTY.LSP =============================

(Defun C:TXS () (Setvar "Cmdecho" 0) (Initget 1 "SE ST ")
(Setq G (Strcase (Substr (Getkword "STyle/<SElection>:")1 2)))
(Cond ((= G "SE") (Setq A (Ssget)) (Setq B (Sslength A))
(Initget 1) (Setq C (Getstring "\nEnter new text style: "))
(Extang C) (While (> B 0) (Setq B (1- B)) (Setq D (Ssname A B))
(Setq D (Entget D)) (Setq E (Assoc 7 D)) (Setq F (Cons 7 C))
(Setq D (Subst F E D)) (Setq H (Assoc 51 D)) (Setq I (Cons 51 J))
(Entmod (Subst I H D))) (Setq A nil)) ((Or (= G "ST") (= G ""))
(Initget 1) (Setq A (Strcase (Getstring
"\nEnter text style to change: "))) (Initget 1)
(Setq C (Getstring "\nEnter new text style: "))(Setq D (Entnext))
(Extang C) (While D (Princ ".") (Setq E (Entget D)) (If
(And (= "TEXT" (Cdr (Assoc 0 E))) (= A (Cdr (Assoc 7 E))))
(Progn (Setq F (Assoc 7 E)) (Setq G (Cons 7 C))
(Setq E (Subst G F E)) (Setq H (Assoc 51 E)) (Setq I (Cons 51 J))
(Entmod (Subst I H E)))) (Setq D (Entnext D))))) (Princ))

(Defun Extang (A) (Setq A (Tblsearch "STYLE" A))
(Setq J (Cdr (Assoc 50 A))))

;;; ============================ DRAW CLOUD =============================

(defun CLOUD (/ pt1 pt2 arc1 cnt ss la) (setvar "cmdecho" 0)
(prompt "\nVe cloud (may) khong khep kin - Tu khep kin ve diem dau!")
(setq la (getvar "clayer"))
(command "layer" "m" "cloud" "c" "5" "" "")
(setq pt1 (getpoint "\nEnter first point of Cloud: "))
(if pt1 (prompt "\nProceed in a COUNTER-CLOCKWISE direction..."))
(setq cnt 1 ss (ssadd))
(while pt1 (setq pt2 (getpoint "\nEnter next point - and close: "))
(if pt2 (progn (command "arc" pt1 "e" pt2 "r" (/ (distance pt1 pt2) 1.75))
(if (= cnt 1) (setq arc1 (entlast) cnt 2) (ssadd (entlast) ss)) ))
(setq pt1 pt2) ) (setvar "highlight" 0) (if (> (sslength ss) 0)
(command "pedit" arc1 "y" "j" ss "" "x")
(if arc1 (command "pedit" arc1 "y" "x")) ) (setvar "highlight" 1)
(command "layer" "s" la "") (setvar "cmdecho" 1) (princ))
(DEFUN C:CLOUD () (CLOUD)) (DEFUN C:CLO () (CLOUD))

;;; ================================ Funtion-Dulieu ========================
;;; ================================ Funtion-Dulieu ========================
;;; ================================ Funtion-Dulieu ========================

(defun ha:nhap (kytu thamso) (princ kytu) (princ thamso) (princ ">: ") (setq key (getint)) (if key (setq thamso key)) (princ thamso) )
(defun ha:thoat () (reinit) (setq Temp "Da thoat khoi chuong trinh"))
(defun khoangcach (kh khq11 khq12 / h0 h1) (setq h1 (polar kh (angle '(0 0) (vectophap khq11 khq12)) 500)) (setq h0 (inters khq11 khq12 kh h1 nil)) (distance kh h0))
(defun hacat (hacat1 hacat2 / hacat3 chon) (if (and (/= hacat1 nil) (/= hacat2 nil)) (progn (setq hacat3 (polar hacat1 (angle hacat1 hacat2) (/ (distance hacat1 hacat2) 2))) (setq chon (ssget hacat3)) (command "break" chon hacat1 hacat2)  ) ) (princ) )
(defun hauon (hauon1 hauon2) (command "fillet" hauon1 hauon2))
(defun init () (setvar "blipmode" 0) (setvar "cmdecho" 0) (setvar "angbase" 0))
(defun reinit () (setvar "cmdecho" 1) (setvar "osmode" 0))
(defun tichvecto (vecto1 vecto2) (apply '+ (mapcar '* vecto1 vecto2)))
(defun vectophap (v01 v02 / vectochiphuong) (setq vectochiphuong (mapcar '- v01 v02)) (list (cadr vectochiphuong) (* -1 (car vectochiphuong))))
(defun ha:giaodiem (dc1 p1 p2 / hc hc1 diem1) (setq diem1 (vectophap p1 p2)) (setq hc1 (polar dc1 (angle '(0.0 0.0) diem1) 100)) (setq hc (inters p1 p2 dc1 hc1 nil)))
(defun dtr (dtr) (* pi (/ dtr 180.0)))
(defun rtd (rtd) (* 180.0 (/ rtd pi)))

;;;==============================PROGRAME===============================
;;;=====================EditDiM Hien Hop Thoai Dep======================
;;;==============================PROGRAME===============================

;;Dth Edit Text, Dimtex & Attributes(Chu Co Thuoc Tinh)
;;Chay Cung Du Lieu.Lsp & Hai.Dcl
(Defun Hai_Edim (Chon / Dial State Str Oldlis Dimdefault Pt10 Pt13 Pt14 St Ang Dis Pt Hc)
  (Setq Oldlis (Entget (Car Chon))
      Pt10 (Cdr (Assoc 10 Oldlis))
      Pt13 (Cdr (Assoc 13 Oldlis))
      Pt14 (Cdr (Assoc 14 Oldlis))
      St  (Cdr (Assoc 70 Oldlis))
      Dimdefault (Cdr (Assoc 1 Oldlis))
      )
  (Cond
((Or (= 32 St)(= 0 St)(= 160 St))
   (Progn
   (Setq Ang (Cdr (Assoc 50 Oldlis))
         Pt (Polar Pt13 Ang 500)
         Hc (Lay_Hinh_Chieu Pt10 Pt13 Pt)
         Dis (Rtos (Distance Pt13 Hc))
         )
   )
   )
((Or (= 33 St)(= 1 St))
   (Progn(Setq Dis (Rtos (Distance Pt13 Pt14)))))
);;End Cond
  (If (= Dimdefault "") (Setq Dimdefault "<>"))
  (Setq Dial (Load_Dialog "Hai.Dcl"))
  (If (Not (New_Dialog "eddim" Dial)) (Exit))
  (If (Or (= 32 St)(= 0 St)(= 160 St)(= 33 St)(= 1 St))
(Set_Tile "text" Dis))
  (Set_Tile "ha:edim" Dimdefault)
  (Mode_Tile "ha:edim" 2); Tao Dau Nhac Tai Hop Thoai
  (Action_Tile "ha:edim" "(Setq Str (Get_Tile \"ha:edim\"))(Done_Dialog 3)")
  (Setq State (Start_Dialog))(Unload_Dialog Dial)
  (If (And Str (= 3 State))
(Progn
   (Setq Oldlis (Subst (Cons 1 Str) (Assoc 1 Oldlis) Oldlis))(Entmod Oldlis)))
  )
(Defun C:EH (/ Chon Name )
  (Defun *Error* (Msg)
(Princ "\nerror: ")(Princ Msg)(Princ "  ")
(Start_Dialog)(Unload_Dialog Dial)
(Setq *Error* Olderr)(Princ)
)
  (Setq Olderr *Error*)
  (Setq Chon T)
  (While Chon
(Setq Chon (Entsel "\n\n\nSelect Text, Dimtext Or Attributes To Edit..."))
(If Chon
   (Progn
      (Setq Name (Cdr (Assoc 0 (Entget (Car Chon)))))
      (Cond
      ((= Name "INSERT")(Command "Ddatte" Chon))
      ((Or (= Name "TEXT") (= Name "ATTDEF") (= Name "TOLERANCE") (= Name "MTEXT"))(Command "Ddedit" Chon ""))
      ((= Name "DIMENSION") (Hai_Edim Chon))
      )
      );End Cond
   );End Progn
);End While
  (Setq Olderr *Error*)(Princ)
  );End Program

;;;====================DDeditDim=====================
;;;=====================Hai.DCL======================
;;;====================DDeditDim=====================

;;Dth Edit Text, Dimtex & Attributes(Chu Co Thuoc Tinh)
;;Chay Cung Du Lieu.Lsp & Hai.Dcl
(Defun Hai_Edim (Chon / Dial State Str Oldlis Dimdefault Pt10 Pt13 Pt14 St Ang Dis Pt Hc)
  (Setq Oldlis (Entget (Car Chon))
      Pt10 (Cdr (Assoc 10 Oldlis))
      Pt13 (Cdr (Assoc 13 Oldlis))
      Pt14 (Cdr (Assoc 14 Oldlis))
      St  (Cdr (Assoc 70 Oldlis))
      Dimdefault (Cdr (Assoc 1 Oldlis))
      )
  (Cond
((Or (= 32 St)(= 0 St)(= 160 St))
   (Progn
   (Setq Ang (Cdr (Assoc 50 Oldlis))
         Pt (Polar Pt13 Ang 500)
         Hc (Lay_Hinh_Chieu Pt10 Pt13 Pt)
         Dis (Rtos (Distance Pt13 Hc))
         )
   )
   )
((Or (= 33 St)(= 1 St))
   (Progn(Setq Dis (Rtos (Distance Pt13 Pt14)))))
);;End Cond
  (If (= Dimdefault "") (Setq Dimdefault "<>"))
  (Setq Dial (Load_Dialog "Hai.Dcl"))
  (If (Not (New_Dialog "eddim" Dial)) (Exit))
  (If (Or (= 32 St)(= 0 St)(= 160 St)(= 33 St)(= 1 St))
(Set_Tile "text" Dis))
  (Set_Tile "ha:edim" Dimdefault)
  (Mode_Tile "ha:edim" 2); Tao Dau Nhac Tai Hop Thoai
  (Action_Tile "ha:edim" "(Setq Str (Get_Tile \"ha:edim\"))(Done_Dialog 3)")
  (Setq State (Start_Dialog))(Unload_Dialog Dial)
  (If (And Str (= 3 State))
(Progn
   (Setq Oldlis (Subst (Cons 1 Str) (Assoc 1 Oldlis) Oldlis))(Entmod Oldlis)))
  )
(Defun C:EH (/ Chon Name )

;;;********************Du Lieu********************

(Defun Ha:Thoat () (Reinit) (Setq Temp "Da Thoat Khoi Chuong Trinh"))
(Defun Hacat (Hacat1 Hacat2 / Hacat3 Chon)
  (If (And (/= Hacat1 Nil) (/= Hacat2 Nil))
(Progn
   (Setq Hacat3 (Polar Hacat1 (Angle Hacat1 Hacat2) (/ (Distance Hacat1 Hacat2) 2)))
   (Setq Chon (Ssget Hacat3))
   (Command "Break" Chon Hacat1 Hacat2)
   )
)
  (Princ)
  )
;;
(Defun Hauon (Hauon1 Hauon2)(Command "Fillet" Hauon1 Hauon2))
;;
(Defun Taolop (Mau Lop / A)(Setq A(Tblsearch "Layer" Lop))(If (Null A)(Command "Layer" "_N" Lop "_C" Mau Lop "")) (Setvar "Clayer" Lop))
;;
(Defun Init ()(Setvar "Blipmode" 0)(Setvar "Cmdecho" 0)(Setvar "Angbase" 0))
;;
(Defun Reinit ()(Setvar "Cmdecho" 1))
;;
(Defun Tichvecto (Vecto1 Vecto2)(Apply '+ (Mapcar '* Vecto1 Vecto2)))
;;
;;Cho 2 Diem Tinh Ra Vec To Phap
(Defun Vectophap (V01 V02 / Vectochiphuong)(Setq Vectochiphuong(Mapcar '- V01 V02)) (List (Cadr Vectochiphuong) (* -1 (Car Vectochiphuong))))
;;Xac Dinh Vi Tri Hinh Chieu 1 Diem Len 1 Duong Thang
;;Da Biet 2 Diem Thuoc Duong Thang
(Defun Lay_Hinh_Chieu (Dc1 P1 P2 / Hc Dc2)
  (Setq Dc2 (Polar Dc1 (+ (/ Pi 2) (Angle P1 P2)) 100)
      Hc (Inters P1 P2 Dc1 Dc2 Nil)))
;;Xac Dinh Khoang Cach Tu 1 Diem Len 1 Duong Thang
;;Da Biet 2 Diem Thuoc Duong Thang
(Defun Khoangcach (Dc1 P1 P2 / Dc2 Hc)
  (Setq Dc2 (Polar Dc1 (+ (/ Pi 2) (Angle P1 P2)) 100)
      Hc (Inters P1 P2 Dc1 Dc2 Nil))
  (Distance Dc1 Hc)
  )
(load "nhapcua.lsp")
  (Defun *Error* (Msg)
(Princ "\nerror: ")(Princ Msg)(Princ "  ")
(Start_Dialog)(Unload_Dialog Dial)
(Setq *Error* Olderr)(Princ)
)
  (Setq Olderr *Error*)
  (Setq Chon T)
  (While Chon
(Setq Chon (Entsel "\n\n\nSelect Text, Dimtext Or Attributes To Edit..."))
(If Chon
   (Progn
      (Setq Name (Cdr (Assoc 0 (Entget (Car Chon)))))
      (Cond
      ((= Name "INSERT")(Command "Ddatte" Chon))
      ((Or (= Name "TEXT") (= Name "ATTDEF") (= Name "TOLERANCE") (= Name "MTEXT"))(Command "Ddedit" Chon ""))
      ((= Name "DIMENSION") (Hai_Edim Chon))
      )
      );End Cond
   );End Progn
);End While
  (Setq Olderr *Error*)(Princ)
  );End Program

;===================HAI DCL Nhapcua.LSP De chay Hop Thoai EditDiM===================
;====================================Nhapcua.LSP====================================
;===================HAI DCL Nhapcua.LSP De chay Hop Thoai EditDiM===================

;;; ============================ Ve Hinh chu nhat ==================================
(defun HCN (/ olderr ocmd oblp pt1 pt2 pt3 pt4 l w)
  (setq ocmd (getvar "cmdecho"))
  (setq oblp (getvar "blipmode"))
  (setvar "cmdecho" 0)
  (initget 1)                      ;3D point can't be null
  (setq pt1 (getpoint (strcat "\nCorner of rectangle or square: ")))
  (setvar "ORTHOMODE" 1)
  (initget 7)                      ;Length can't be 0, neg, or null
  (setq l (getdist pt1 "\nLength: "))
  (setq pt2 (list (+ (car pt1) l) (cadr pt1) (caddr pt1)))
  (grdraw pt1 pt2 2)
  (initget 7 "Square")             ;Width can't be 0, neg, or null
  (setq w (getdist pt1 "\nSquare/<Width>: "))
  (if (= w "Square")
   (setq w l)  )
  (setq pt3 (list (car pt2) (+ (cadr pt2) w) (caddr pt2)))
  (setq pt4 (list (car pt1) (+ (cadr pt1) w) (caddr pt1)))
  (grdraw pt2 pt3 2)
  (grdraw pt3 pt4 2)
  (grdraw pt4 pt1 2)
  (setvar "ORTHOMODE" 0)
  (command "pline"  pt1 pt2 pt3 pt4 "close")
  (setvar "cmdecho" ocmd)
  (setvar "blipmode" oblp) (princ))
(DEFUN C:HCN () (HCN))

;*******************;*******************;*******************;*******************
;****K E T C A U****;****K E T C A U****;****K E T C A U****;****K E T C A U****
;*******************;*******************;*******************;*******************

;VE HINH BINH HANH

(defun c:binhhanh (/ p1 p2 p3)
(setq p1 (getpoint "\n Nhap diem thu nhat:"))
(setq p2 (getpoint p1 "\n Nhap diem thu hai:"))
(setq om (getvar "osmode"))
(setvar "osmode" 0)
(command "line" p1 p2 "")
(setvar "osmode" om)
(setq p3 (getpoint p2 "\n Nhap diem thu ba:"))
(setq a (angle p2 p1))
(setq d (distance p1 p2))
(setq p4 (polar p3 a d))
(command "OSNAP" "none")
(command "erase" "l" "")
(command "pline" p1 p2 p3 p4 p1 "")
(setvar "osmode" om)
)

;VE LUOI COT

(defun c:LuoiCot ()
(setq om (getvar "osmode"))
(setvar "osmode" 0)
(setq tile (getreal "\nCho biet Ti Le ve 1/x, x="))
(setq p0 (getpoint "\n Chon Basic Point:"))
(setq nc (getreal "\n Nhap chieu ngang cua cot : "))
(setq dc (getreal "\n Nhap chieu doc cua cot : "))
(setq p1       (polar       (polar p0 pi (/ (* nc hstl) 2 tile) ) (* pi 1.5) (/ (* dc hstl) 2 tile)  )  )
(setq p2       (polar       (polar p0 0 (/ (* nc hstl) 2 tile) ) (* pi 0.5) (/ (* dc hstl) 2 tile)  )  )
(command "rectang" p1 p2)
(command "hatch" "solid" "l" "")
(setq bcn (getreal "\n Buoc cot theo phuong ngang : "))
(setq nn (getint "\n So buoc cot phuong ngang : "))
(setq w1       (polar       (polar p1 pi (/ (* nc hstl) 2 tile) ) (* pi 1.5) (/ (* dc hstl) 2 tile)  )  )
(setq w2       (polar       (polar p2 0 (/ (* nc hstl) 2 tile) ) (* pi 0.5) (/ (* dc hstl) 2 tile)  )  )
(command "select" "w" w1 w2 "")
(command "array" "p" "" "r" "1" (+ nn 1) (/ (* bcn hstl) tile) )
(command "line" (polar p0 pi (/ (* 1000 hstl) tile)) (polar p0 0 (/ (* (+ (* bcn nn) 1000) hstl) tile) ) "")
(setq w1 (polar (polar p0 pi (/ (* hstl 2000) tile)) (* pi 1.5)  (/ (* hstl 2000) tile) ))
(setq w2 (polar (polar p0 0 (/ (* (+ (* bcn nn) 2000) hstl) tile) ) (* pi 0.5)  (/ (* hstl 2000) tile) ))
(command "zoom" "w" w1 w2)
(command "select" "w" w1 w2 "")
(setq bcd (getreal "\n Buoc cot theo phuong doc : "))
(setq nd (getint "\n So buoc cot phuong doc : "))
(command "array" "p" "" "r" (+ nd 1) "1" (/ (* hstl bcd) tile) )
(command "line" (polar p0 (* pi 1.5) (/ (* hstl 1000) tile))  (polar p0 (* pi 0.5)  (/ (* (+ (* bcd nd) 1000) hstl) tile))  "")
(command "array" "l" "" "r" "1" (+ nn 1) (/ (* hstl bcn) tile) )
(setq w2 (polar w2 (* pi 0.5) (/ (* (+ (* bcd nd) 2000) hstl) tile))  )
(command "zoom" "w" w1 w2)
(setvar "osmode" om)
)

;VE CUA DI

(defun c:cuadi ()
(setq om (getvar "osmode"))
(setvar "osmode" 0)

(setq tile (getreal "\nCho biet Ti Le ve 1/x, x="))
(setq b (getreal "\n Nhap be rong cua : "))
(setvar "osmode" om)
(while (< 0 1)
(progn
(setq p0 (getpoint "\n Chon Basic Point:"))
(setq p1 (getpoint p0 "\n Chon diem de xac dinh huong cua cua:"))
(command "osnap" "none")
(setq p2 (getpoint p0 "\n Chon diem de xac dinh huong mo cua:"))
(setq a1 (angle p0 p1))
(setq p1 (polar p0 a1 (/ (* hstl b) tile)))
(setq a2 (angle p0 p2))
(if (< (- a2 a1) pi) (setq a3 (+ (/ pi 2) a1)) (setq a3 (- a1 (/ pi 2))) )
(command "pline" p0 "w" "0" "0" p1 (polar p1 a3 (/ (* hstl 40) tile)) (polar p0 a3 (/ (* hstl 40) tile)) p0 "")
(command "rotate" "l" "" p0 (/ (* (- a3 a1) 180) pi))
(command "arc" "ce" p0 p1 "a" (/ (* (- a3 a1) 180) pi))
(setvar "osmode" om)
))
)

;VE CUA SO

(defun c:cuaso ()
(setq om (getvar "osmode"))
(setvar "osmode" 0)

(setq tile (getreal "\nCho biet Ti Le ve 1/x, x="))
(setvar "osmode" om)
(while (< 0 1)
(progn
(setq p0 (getpoint "\n Chon Basic Point:"))
(setq p1 (getpoint p0 "\n Chon diem de xac dinh be rong cua:"))
(command "osnap" "none")
(setq p2 (getpoint p1 "\n Chon 1 diem o trong nha de xac dinh huong cua so:"))
(setq b (distance p0 p1))
(if (< b  (/ (* hstl 600) tile)) (setq du 50))
(if (> b  (/ (* hstl 600) tile)) (setq du 150))
(if (> b (/ (* hstl 1800) tile)) (setq du 200))
(setq a1 (angle p0 p1))
(setq a2 (angle p0 p2))
(if (> a2 pi) (setq a2 (- a2 (* pi 2)) )  )
(if (> (- a2 a1) 0) (setq a3 (+ (/ pi 2) a1))  )
(if (> (- a1 a2) 0) (setq a3 (- a1 (/ pi 2)))  )
(command "pline" p0 "w" "0" "0" p1 "")
(command "pline" (polar p0 a3 (/ (* hstl 50) tile)) (polar p1 a3 (/ (* hstl 50) tile)) "")
(command "pline" (polar p0 a3 (/ (* hstl 100) tile)) (polar p1 a3 (/ (* hstl 100) tile)) "")
(command "pline" (polar p0 a1 (* (- du) (/ hstl tile))) (polar (polar p0 a1 (* (- du) (/ hstl tile))) a3 (* -100 (/ hstl tile)))
            (polar (polar p1 a1 (* du (/ hstl tile))) a3 (* -100 (/ hstl tile))) (polar p1 a1 (* du (/ hstl tile))) "")
(setvar "osmode" om)
))
)

;;;=== General Utility Functions ===

; R12 compatibility - In R12 (acad_helpdlg) was an externally-defined
; ADS function.  Now it's a simple AutoLISP function that calls the
; built-in function (help).  It's only purpose is R12 compatibility.
; If you are calling it for anything else, you should almost certainly
; be calling (help) instead.

(defun acad_helpdlg (helpfile topic)
  (help helpfile topic)
)

(defun *merr* (msg)
  (setq *error* m:err m:err nil)
  (princ)
)

(defun *merrmsg* (msg)
  (princ msg)
  (setq *error* m:err m:err nil)
  (princ)
)

;; Loads the indicated ARX app if it isn't already loaded
;; returns nil if no load was necessary, else returns the
;; app name if a load occurred.
(defun verify_arxapp_loaded (app)
  (if (not (loadedp app (arx)))
   (arxload app f)
  )
)

;; determines if a given application is loaded...
;; general purpose: can ostensibly be used for appsets (arx) or (ads) or....
;;
;; app is the filename of the application to check (extension is required)
;; appset is a list of applications, (such as (arx) or (ads)
;;
;; returns T or nil, depending on whether app is present in the appset
;; indicated.  Case is ignored in comparison, so "foo.arx" matches "FOO.ARX"
;; Also, if appset contains members that contain paths, app will right-match
;; against these members, so "bar.arx" matches "c:\\path\\bar.arx"; note that
;; "bar.arx" will *not* match "c:\\path\\foobar.arx."
(defun loadedp (app appset)
  (cond (appset  (or
                  ;; exactly equal? (ignoring case)
                  (= (strcase (car appset))
                     (strcase app))
                  ;; right-matching? (ignoring case, but assuming that
                  ;; it's a complete filename (with a backslash before it)
                                       (and
                                          (> (strlen (car appset)) (strlen app))
                           (= (strcase (substr (car appset)
                                             (- (strlen (car appset))
                                                (strlen app)
                                             )
                                       )
                              )
                              (strcase (strcat "\\" app))
                           )
                                 )
                  ;; no match for this entry in appset, try next one....
                  (loadedp app (cdr appset)) )))
)

;;; ===== Single-line MText editor =====
(defun LispEd (contents / fname dcl state)
  (if (not (setq fname (getvar "program")))
   (setq fname "acad")
  )
  (strcat fname ".dcl")
  (setq dcl (load_dialog fname))
  (if (not (new_dialog "LispEd" dcl)) (exit))
  (set_tile "contents" contents)
  (mode_tile "contents" 2)
  (action_tile "contents" "(setq contents $value)")
  (action_tile "accept" "(done_dialog 1)")
  (action_tile "mtexted" "(done_dialog 2)" )
  (setq state (start_dialog))
  (unload_dialog dcl)
  (cond
((= state 1) contents)
((= state 2) -1)
(t 0)
  )
)

;;; ===== Discontinued commands =====
(defun c:ddselect(/ cmdecho-save)
  (setq cmdecho-save (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "._+options" 7)
  (setvar "CMDECHO" cmdecho-save)
  (princ)
)

(defun c:ddgrips(/ cmdecho-save)
  (setq cmdecho-save (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "._+options" 7)
  (setvar "CMDECHO" cmdecho-save)
  (princ)
)

(defun c:gifin ()
  (alert "\nThe GIFIN command is no longer supported.\nUse the IMAGE command to attach raster image files.\n")
  (princ)
)

(defun c:pcxin ()
  (alert "\nThe PCXIN command is no longer supported.\nUse the IMAGE command to attach raster image files.\n")
  (princ)
)

(defun c:tiffin ()
  (alert "\nThe TIFFIN command is no longer supported.\nUse the IMAGE command to attach raster image files.\n")
  (princ)
)

(defun c:ddemodes()
  (alert "The Object Properties toolbar incorporates DDEMODES functionality.  \nDDEMODES has been discontinued.  \n\nFor more information, select \"Object Properties toolbar\" from the AutoCAD Help Index tab.")
  (princ)
)

(defun c:ddrmodes(/ cmdecho-save)
  (setq cmdecho-save (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "._+dsettings" 0)
  (setvar "CMDECHO" cmdecho-save)
  (princ)
)

;; HPCONFIG
(defun c:hpconfig (/ hlppath)
  (if (not (setq hlppath (findfile "acad.hlp")))
(setq hlppath ""))
  (help hlppath "hpconfig")
  (princ)
)

;; OCECONFIG
(defun c:oceconfig (/ hlppath)
  (if (not (setq hlppath (findfile "acad.hlp")))
(setq hlppath ""))
  (help hlppath "oceconfig")
  (princ)
)

;; CCONFIG
(defun c:cconfig (/ hlppath)
  (if (not (setq hlppath (findfile "acad.hlp")))
(setq hlppath ""))
  (help hlppath "cconfig")
  (princ)
)

;;; ===== AutoLoad =====

;;; Check list of loaded <apptype> applications ("ads" or "arx")
;;; for the name of a certain appplication <appname>.
;;; Returns T if <appname> is loaded.

(defun ai_AppLoaded (appname apptype)
(apply 'or
   (mapcar
      '(lambda (j)
         (wcmatch
            (strcase j T)
            (strcase (strcat "*" appname "*") T)
         )
      )
      (eval (list (read apptype)))
   )
)
)

;;
;;  Native Rx commands cannot be called with the "C:" syntax.  They must
;;  be called via (command).  Therefore they require their own autoload
;;  command.

(defun autonativeload (app cmdliste / qapp)
  (setq qapp (strcat "\"" app "\""))
  (setq initstring "\nInitializing...")
  (mapcar
'(lambda (cmd / nom_cmd native_cmd)
   (progn
      (setq nom_cmd (strcat "C:" cmd))
      (setq native_cmd (strcat "\"_" cmd "\""))
      (if (not (eval (read nom_cmd)))
         (eval
         (read (strcat
                  "(defun " nom_cmd "()"
                  "(setq m:err *error* *error* *merrmsg*)"
                  "(if (ai_ffile " qapp ")"
                  "(progn (princ initstring)"
                  "(_autoarxload " qapp ") (command " native_cmd "))"
                  "(ai_nofile " qapp "))"
                  "(setq *error* m:err m:err nil))"
                  ))))))
cmdliste)
  nil
)

(defun _autoqload (quoi app cmdliste / qapp symnam)
  (setq qapp (strcat "\"" app "\""))
  (setq initstring "\nInitializing...")
  (mapcar
'(lambda (cmd / nom_cmd)
   (progn
      (setq nom_cmd (strcat "C:" cmd))
      (if (not (eval (read nom_cmd)))
         (eval
         (read (strcat
                  "(defun " nom_cmd "( / rtn)"
                  "(setq m:err *error* *error* *merrmsg*)"
                  "(if (ai_ffile " qapp ")"
                  "(progn (princ initstring)"
                  "(_auto" quoi "load " qapp ") (setq rtn (" nom_cmd ")))"
                  "(ai_nofile " qapp "))"
                  "(setq *error* m:err m:err nil)"
                  "rtn)"
                  ))))))
cmdliste)
  nil
)

(defun autoload (app cmdliste)
  (_autoqload "" app cmdliste)
)

(defun autoarxload (app cmdliste)
  (_autoqload "arx" app cmdliste)
)

(defun autoarxacedload (app cmdliste / qapp symnam)
  (setq qapp (strcat "\"" app "\""))
  (setq initstring "\nInitializing...")
  (mapcar
'(lambda (cmd / nom_cmd)
   (progn
      (setq nom_cmd (strcat "C:" cmd))
      (if (not (eval (read nom_cmd)))
         (eval
         (read (strcat
                  "(defun " nom_cmd "( / oldcmdecho)"
                  "(setq m:err *error* *error* *merrmsg*)"
                  "(if (ai_ffile " qapp ")"
                  "(progn (princ initstring)"
                  "(_autoarxload " qapp ")"
                  "(setq oldcmdecho (getvar \"CMDECHO\"))"
                  "(setvar \"CMDECHO\" 0)"
                  "(command " "\"_" cmd "\"" ")"
                  "(setvar \"CMDECHO\" oldcmdecho))"
                  "(ai_nofile " qapp "))"
                  "(setq *error* m:err m:err nil)"
                  "(princ))"
                  ))))))
cmdliste)
  nil
)

(defun _autoload (app)
; (princ "Auto

load ") (princ app) (princ ")") (terpri)
(load app)
)

(defun _autoarxload (app)
; (princ "Auto

arxload ") (princ app) (princ ")") (terpri)
  (arxload app)
)

(defun ai_ffile (app)
  (or (findfile (strcat app ".lsp"))
   (findfile (strcat app ".exp"))
   (findfile (strcat app ".exe"))
   (findfile (strcat app ".arx"))
   (findfile app)
  )
)

(defun ai_nofile (filename)
  (princ
(strcat "\nThe file "
         filename
         "(.lsp/.exe/.arx) was not found in your search path folders."
)
  )
  (princ "\nCheck the installation of the support files and try again.")
  (princ)
)

;;;===== AutoLoad LISP Applications =====
;  Set help for those apps with a command line interface

(autoload "edge"  '("edge"))
(setfunhelp "C:edge" "" "edge")

(autoload "filter" '("filter " "filter"))

(autoload "3d" '("3d" "3d" "ai_box" "ai_pyramid" "ai_wedge" "ai_dome"
               "ai_mesh" "ai_sphere" "ai_cone" "ai_torus" "ai_dish")
)
(setfunhelp "C:3d" "" "3d")
(setfunhelp "C:ai_box" "" "3d_box")
(setfunhelp "C:ai_pyramid" "" "3d_pyramid")
(setfunhelp "C:ai__wedge" "" "3d_wedge")
(setfunhelp "C:ai_dome" "" "3d_dome")
(setfunhelp "C:ai_mesh" "" "3d_mesh")
(setfunhelp "C:ai_sphere" "" "3d_sphere")
(setfunhelp "C:ai_cone" "" "3d_cone")
(setfunhelp "C:ai_torus" "" "3d_torus")
(setfunhelp "C:ai_dish" "" "3d_dish")

(autoload "3darray" '("3darray"))
(setfunhelp "C:3darray" "" "3darray")

(autoload "ddvpoint" '("ddvpoint"))

(autoload "mvsetup" '("mvsetup"))
(setfunhelp "C:mvsetup" "" "mvsetup")

(autoload "ddptype" '("ddptype"))

(autoload "attredef" '("attredef"))
(setfunhelp "C:attredef" "" "attredef")

(autoload "xplode" '("xp" "xplode"))
(setfunhelp "C:xplode" "" "xplode")

(autoload "tutorial" '("tutdemo" "tutclear"
                                    "tutdemo"
                                    "tutclear"))

;;;===== AutoArxLoad Arx Applications =====

(autoarxload "geomcal" '("cal" "cal"))

(autoarxload "geom3d" '("mirror3d" "rotate3d" "align"
                  "mirror3d" "rotate3d"
                              "align"))

;;; ===== Double byte character handling functions =====

(defun is_lead_byte(code)
(setq asia_cd (getvar "dwgcodepage"))
(cond
      ( (or (= asia_cd "dos932")
            (= asia_cd "ANSI_932")
      )
      (or (and (<= 129 code) (<= code 159))
            (and (<= 224 code) (<= code 252))
      )
      )
      ( (or (= asia_cd "big5")
            (= asia_cd "ANSI_950")
      )
      (and (<= 129 code) (<= code 254))
      )
      ( (or (= asia_cd "gb2312")
            (= asia_cd "ANSI_936")
      )
      (and (<= 161 code) (<= code 254))
      )
      ( (or (= asia_cd "johab")
            (= asia_cd "ANSI_1361")
      )
      (and (<= 132 code) (<= code 211))
      )
      ( (or (= asia_cd "ksc5601")
            (= asia_cd "ANSI_949")
      )
      (and (<= 129 code) (<= code 254))
      )
)
)

;;; ====================================================

;;;
;;;  FITSTR2LEN
;;;
;;;  Truncates the given string to the given length.
;;;  This function should be used to fit symbol table names, that
;;;  may turn into \U+ sequences into a given size to be displayed
;;;  inside a dialog box.
;;;
;;;  Ex: the following string:
;;;
;;;    "This is a long string that will not fit into a 32 character static text box."
;;;
;;;    would display as a 32 character long string as follows:
;;;
;;;    "This is a long...tatic text box."
;;;

(defun fitstr2len (str1 maxlen)

;;; initialize internals
(setq tmpstr str1)
(setq len (strlen tmpstr))

(if (> len maxlen)
      (progn
         (setq maxlen2 (/ maxlen 2))
         (if (> maxlen (* maxlen2 2))
               (setq maxlen2 (- maxlen2 1))
         )
         (if (is_lead_byte (substr tmpstr (- maxlen2 2) 1))
               (setq tmpstr1 (substr tmpstr 1 (- maxlen2 3)))
               (setq tmpstr1 (substr tmpstr 1 (- maxlen2 2)))
         )
         (if (is_lead_byte (substr tmpstr (- len (- maxlen2 1)) 1))
               (setq tmpstr2 (substr tmpstr (- len (- maxlen2 3))))
               (setq tmpstr2 (substr tmpstr (- len (- maxlen2 2))))
         )
         (setq str2 (strcat tmpstr1 "..." tmpstr2))
      ) ;;; progn
      (setq str2 (strcat tmpstr))
) ;;; if
) ;;; defun

;;;
;;;  If the first object in a selection set has an attached URL
;;;  Then launch browser and point to the URL.
;;;  Called by the Grips Cursor Menu
;;;

(defun C:gotourl ( / ssurl url i)
(setq m:err *error* *error* *merrmsg* i 0)

; if some objects are not already pickfirst selected,
; then allow objects to be selected

  (if (not (setq ssurl (ssget "_I")))
   (setq ssurl (ssget))
  )

; if geturl LISP command not found then load arx application

  (if (/= (type geturl) 'EXRXSUBR)
(arxload "dwfout")
  )

;  Search list for first object with an URL
  (while (and (= url nil) (< i (sslength ssurl)))
(setq url (geturl (ssname ssurl i))
      i (1+ i))
  )

; If an URL has be found, open browser and point to URL
  (if (= url nil)
(alert "No Universal Resource Locator associated with the object.")
(command "_.browser" url)
  )

  (setq *error* m:err m:err nil)
  (princ)

)

;; Used by the import dialog to silently load a 3ds file
(defun import3ds (filename / filedia_old render)
  ;; Load Render if not loaded
  (setq render (findfile "acRender.arx"))
  (if render
(verify_arxapp_loaded render)
(quit)
  )

  ;; Save current filedia & cmdecho setting.
  (setq filedia-save (getvar "FILEDIA"))
  (setq cmdecho-save (getvar "CMDECHO"))
  (setvar "FILEDIA" 0)
  (setvar "CMDECHO" 0)

  ;; Call 3DSIN and pass in filename.
  (c:3dsin 1 filename)

  ;; Reset filedia & cmdecho
  (setvar "FILEDIA" filedia-save)
  (setvar "CMDECHO" cmdecho-save)
  (princ)
)

;;;=== Menu Functions ======================================

(defun ai_rootmenus ()
  (setq T_MENU 0)
  (menucmd "S=S")
  (menucmd "S=ACAD.S")
  (princ)
)

(defun c:ai_fms ( / fmsa fmsb)
  (setq m:err *error* *error* *merr*)
  (ai_undo_push)
  (if (getvar "TILEMODE") (setvar "TILEMODE" 0))
  (setq fmsa (vports) fmsb (nth 0 fmsa))
  (if (member 1 fmsb)
(if (> (length fmsa) 1)
   (command "_.mspace")
   (progn
      (ai_sysvar '("cmdecho" . 1))
      (command "_.mview")
      (while (eq 1 (logand 1 (getvar "CMDACTIVE")))
      (command pause)
      )
      (ai_sysvar NIL)
      (command "_.mspace")
   )
)
  )
  (ai_undo_pop)
  (setq *error* m:err m:err nil)
  (princ)
)

(defun ai_onoff (var)
  (setvar var (abs (1- (getvar var))))
  (princ)
)

;;; go to paper space
(defun c:ai_pspace ()
  (ai_undo_push)
  (if (/= 0 (getvar "tilemode"))
(command "_.tilemode" 0)
  )
  (if (/= 1 (getvar "cvport"))
(command "_.pspace")
  )
  (ai_undo_pop)
  (princ)
)

;;; go to tilemode 1
(defun c:ai_tilemode1 ()
  (ai_undo_push)
  (if (/= 1 (getvar "tilemode"))
(command "_.tilemode" 1)
  )
  (ai_undo_pop)
  (princ)
)

;;; Pop menu Draw/ Dim/ Align Text/ Centered
;;; Toolbar Dimensions/ Align Text/ Centered

(defun ai_dim_cen (/ ai_sysvar ai_dim_ss)
  (setq ai_sysvar (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (cond
((setq ai_dim_ss (ssget  "_P" '((0 . "DIMENSION"))))
   (command "_.dimoverride" "_dimjust" 0 "" ai_dim_ss ""
            "_.dimtedit" ai_dim_ss "_h")
)
(T nil)
  )
  (setvar "cmdecho" ai_sysvar)
  (princ)
)

;;; Shortcut menu for Dimension Text Above

(defun c:ai_dim_textabove (/ ss)
  (ai_sysvar '("cmdecho" . 0))
  (if (setq ss (ssget "_I"))
(command "_.dimoverride" "_dimtad" 3 "" ss "")
(if (setq ss (ssget))
   (command "_.dimoverride" "_dimtad" 3 "" ss "")
)
  )
  (ai_sysvar NIL)
  (princ)
)

;;; Shortcut menu for Dimension Text Center

(defun c:ai_dim_textcenter (/ ss)
  (ai_sysvar '("cmdecho" . 0))
  (if (setq ss (ssget "_I"))
(command "_.dimoverride" "_dimtad" 0 "" ss "")
(if (setq ss (ssget))
   (command "_.dimoverride" "_dimtad" 0 "" ss "")
)
  )
  (ai_sysvar NIL)
  (princ)
)

;;; Shortcut menu for Dimension Text Home

(defun c:ai_dim_texthome (/ ss)
  (ai_sysvar '("cmdecho" . 0))
  (if (setq ss (ssget "_I"))
(command "_.dimedit" "_h")
(if (setq ss (ssget))
   (command "_.dimedit" "_h" ss)
)
  )
  (ai_sysvar NIL)
  (princ)
)

;;; Screen menu item for CIRCLE TaTaTan option.
;;;    first, get points on entities
(defun ai_circtanstart()
(setq m:err *error* *error* *merr*)
(ai_sysvar
   (list '("cmdecho" . 0)
      ;; make sure _tan pick for CIRCLE gets same entity
      (cons "aperture"  (getvar "pickbox"))
      )
)
;; prompts are the same as CIRCLE/TTR command option
(setq pt1 (ai_entsnap "\nEnter Tangent spec: "  nil))
(setq pt2 (ai_entsnap "\nEnter second Tangent spec: " nil))
(setq pt3 (ai_entsnap "\nEnter third Tangent spec: "  nil))
)
;;; Command-line version
(defun c:ai_circtan (/ pt1 pt2 pt3)
(ai_circtanstart)

(ai_sysvar '("osmode" . 256))
(command "_.circle" "_3p" "_tan" pt1 "_tan" pt2 "_tan" pt3)

(ai_sysvar nil)
(setq *error* m:err m:err nil)
(princ)
)
;;; Use this if CMDNAMES == CIRCLE
(defun ai_circtan (/ pt1 pt2 pt3)
(ai_circtanstart)

(ai_sysvar '("osmode" . 256))
(command "_3p" pt1  pt2  pt3)

(ai_sysvar nil)
(setq *error* m:err m:err nil)
(princ)
)

;;; Shortcut menu Deselect All item.

(defun ai_deselect ()
(if (= (getvar "cmdecho") 0)                      ;start if
   (command "_.select" "_r" "_all" "")
   (progn                                     ;start progn for cmdecho 1
         (setvar "cmdecho" 0)
         (command "_.select" "_r" "_all" "")
         (setvar "cmdecho" 1)
   )                                     ;end progn for cmdecho 1
)                                              ;end if
(terpri)
(prompt "Everything has been deselected")
(princ)
)

;;; Command version of ai_deselect to be called from the CUI
;;; so it gets properly recorded by the Action Recorder
;;;
(defun c:ai_deselect ()
  (ai_deselect)
  (princ)
)

;;;
;;; Enable Draworder to be called from a menu
;;; Checks for Pickfirst selected objects
;;;

(defun ai_draworder (option / ss )

  (setq m:err *error* *error* *merr*)
  (ai_sysvar '("cmdecho" . 0))

  (if (setq ss (ssget "_I"))
(command "_.draworder" option)
(if (setq ss (ssget))
   (command "_.draworder" ss "" option)
)
  )
  (ai_sysvar NIL)
  (setq *error* m:err m:err nil)

  (princ)
)

;;; Command version of ai_draworder to be called from the CUI
;;; so it gets properly recorded by the Action Recorder
;;;
(defun c:ai_draworder ()
  (initget "Above Under Front Back")
  (ai_draworder (strcat "_" (getkword)))
  (princ)
)

(defun c:vlisp ()
  (if (/= nil c:vlide) (c:vlide))
)

(princ "loaded.")

;; Silent load.
(princ)

;;;----------------------------------------------------------------------------
;;;
;;; DDCHPROP.LSP Version 0.5
;;;
;;; Copyright (C) 1991-1993 by Autodesk, Inc.
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and that
;;; both that copyright notice and this permission notice appear in
;;; all supporting documentation.
;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;; WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;; 2 February 1992
;;;
;;;----------------------------------------------------------------------------
;;; DESCRIPTION
;;;----------------------------------------------------------------------------
;;; C:DDCHPROP is a dialogue interface for the CHPROP command.
;;;
;;; The command looks similar to DDEMODES.  The main dialogue has an image
;;; tile, 3 buttons (layer, color, linetype), and an editbox (thickness).
;;; The 3 buttons each launch a sub-dialogue containing a list and edit box.
;;; The dialogues are all defined in the DDCHPROP.DCL file.
;;;
;;;
;;;----------------------------------------------------------------------------
;;;----------------------------------------------------------------------------
;;; Prefixes in command and keyword strings:
;;;    "."  specifies the built-in AutoCAD command in case it has been
;;;          redefined.
;;;    "_"  denotes an AutoCAD command or keyword in the native language
;;;          version, English.
;;;----------------------------------------------------------------------------
;;;
;;;
;;; ===========================================================================
;;; ===================== load-time error checking ============================
;;;

  (defun ai_abort (app msg)
   (defun *error* (s)
      (if old_error (setq *error* old_error))
      (princ)
   )
   (if msg
   (alert (strcat " Application error: "
                  app
                  " \n\n  "
                  msg
                  "  \n"
            )
   )
   )
   (exit)
  )

;;; Check to see if AI_UTILS is loaded, If not, try to find it,
;;; and then try to load it.
;;;
;;; If it can't be found or it can't be loaded, then abort the
;;; loading of this file immediately, preserving the (autoload)
;;; stub function.

  (cond
   (  (and ai_dcl (listp ai_dcl)))       ; it's already loaded.

   (  (not (findfile "ai_utils.lsp"))                   ; find it
      (ai_abort "DDCHPROP"
               (strcat "Can't locate file AI_UTILS.LSP."
                        "\n Check support directory.")))

   (  (eq "failed" (load "ai_utils" "failed"))          ; load it
      (ai_abort "DDCHPROP" "Can't load file AI_UTILS.LSP"))
  )

  (if (not (ai_acadapp))             ; defined in AI_UTILS.LSP
   (ai_abort "DDCHPROP" nil)       ; a Nil <msg> supresses
  )                                  ; ai_abort's alert box dialog.

;;; ==================== end load-time operations ===========================

;;; Initialize program subroutines and variables.

(defun ddchprop_init ()

  ;;
  ;; Define buttons and set values in CHPROP dialogue box
  ;;
  (defun call_chp ()
(if (not (new_dialog "ch_prop" dcl_id)) (exit))
(set_tile "error" "")
;; Set initial dialogue tile values
(set_col_tile)
(if (= lay-idx nil)
   (set_tile "t_layer" "Varies")
   (set_tile "t_layer" (nth lay-idx laynmlst))
)
(cond
   ((= lt-idx nil)
      (set_tile "t_ltype" "Varies")
   )
   ((= lt-idx 0) ; set tile "By layer & layer linetype"
      (set_tile "t_ltype" (bylayer_lt))
   )
   (T
      (set_tile "t_ltype" (nth lt-idx ltnmlst))
   )
)
(if (or (= ethickness nil) (= ethickness "Varies"))
   (set_tile "eb_thickness" "Varies")
   (set_tile "eb_thickness" (rtos ethickness))
)
;; Define action for tiles
(action_tile "b_color" "(setq ecolor (getcolor))")
(action_tile "show_image" "(setq ecolor (getcolor))")
(action_tile "b_name" "(setq elayer (getlayer))")
(action_tile "b_line" "(setq eltype (getltype))")
(action_tile "eb_thickness"  "(getthickness $value)")
(action_tile "help" "(acad_helpdlg \"acad.hlp\"  \"ddchprop\")")
(action_tile "accept" "(test-ok)")
(if (= (start_dialog) 1)
   (progn
      (command "_.chprop" ss "")
      (if ecolor
      (progn
         (if (= 0 ecolor ) (setq ecolor "BYBLOCK"))
         (if (= 256 ecolor ) (setq ecolor "BYLAYER"))
         (command "_c" ecolor)
      )
      )
      (if (and (/= eltype "Varies") lt-idx)
      (command "_lt" eltype)
      )
      (if (and (/= elayer "Varies") lay-idx)
      (command "_la" elayer)
      )
      (if (and (/= ethickness "Varies") ethickness)
      (command "_t" ethickness)
      )
      (command "")
   )
   (princ "\nProperties unchanged")
)
(princ)
  )
  ;;
  ;; Function to set the Color text tile and swab to the current color value.
  ;;
  (defun set_col_tile()
(cond
   ((= ecolor nil)
      (set_tile "t_color" "Varies")
      (col_tile "show_image" 0 nil)
   )
   ((= ecolor 0)
      (set_tile "t_color" "BYBLOCK")
      (col_tile "show_image" 0 nil)
   )
   ((= ecolor 1)
      (set_tile "t_color" "1 red")
      (col_tile "show_image" 1 nil)
   )
   ((= ecolor 2)
      (set_tile "t_color" "2 yellow")
      (col_tile "show_image" 2 nil)
   )
   ((= ecolor 3)
      (set_tile "t_color" "3 green")
      (col_tile "show_image" 3 nil)
   )
   ((= ecolor 4)
      (set_tile "t_color" "4 cyan")
      (col_tile "show_image" 4 nil)
   )
   ((= ecolor 5)
      (set_tile "t_color" "5 blue")
      (col_tile "show_image" 5 nil)
   )
   ((= ecolor 6)
      (set_tile "t_color" "6 magenta")
      (col_tile "show_image" 6 nil)
   )
   ((= ecolor 7)
      (set_tile "t_color" "7 white")
      (col_tile "show_image" 7 nil)
   )
   ;; If the color is "BYLAYER", then set the tile to
   ;; show it's set By layer, but also indicate the
   ;; color of the layer - i.e. By layer (red)
   ((= ecolor 256)
      (set_tile "t_color" (bylayer_col))
      (col_tile "show_image" cn nil)
   )
   (T
      (set_tile "t_color" (itoa ecolor))
      (col_tile "show_image" ecolor nil)
   )
)
  )
  ;;
  ;;  Function to put up the standard color dialogue.
  ;;
  (defun getcolor(/ col_def lay_clr temp_color)
;; col_def is the default color used when rq_color is called.  If ecolor
;; is nil (varies) then set it to 1, else use the value of ecolor.
(if ecolor
   (setq col_def ecolor)
   (setq col_def 1)
)

;; If we're working with a single layer, get its color
;; for use in the color swatch if the user selects color BYLAYER.
(if (/= elayer "Varies")
   (setq lay_clr (cdr (assoc 62 (tblsearch "layer" elayer))))
   (setq lay_clr 0)
)
(if (numberp (setq temp_color (acad_colordlg col_def T lay_clr)))
   (progn
      (setq ecolor temp_color)
      (set_col_tile)
      ecolor
   )
   ecolor
)
  )
  ;;
  ;; This function pops a dialogue box consisting of a list box, image tile,
  ;; and edit box to allow the user to select or type a linetype.  It returns
  ;; the linetype selected.
  ;;
  (defun getltype (/ old-idx ltname)
;; Initialize a dialogue from dialogue file
(if (not (new_dialog "setltype" dcl_id)) (exit))
(start_list "list_lt")
(mapcar 'add_list ltnmlst)       ; initialize list box
(end_list)
(setq old-idx lt-idx)
;; Show initial ltype in image tile, list box, and edit box
(if (/= lt-idx nil)
   (ltlist_act (itoa lt-idx))
   (progn
      (set_tile "edit_lt" "Varies")
      (col_tile "show_image" 0 nil)
   )
)
(action_tile "list_lt" "(ltlist_act $value)")
(action_tile "edit_lt" "(ltedit_act $value)")
(action_tile "accept" "(test-ok)")
(action_tile "cancel" "(reset-lt)")
(if (= (start_dialog) 1)          ; User pressed OK
   (cond
      ((= lt-idx nil)
      (set_tile "t_ltype" "Varies")
      "Varies"
      )
      ((= lt-idx 0)
      (set_tile "t_ltype" (bylayer_lt))
      "BYLAYER"
      )
      ((= lt-idx 1)
      (set_tile "t_ltype" "BYBLOCK")
      "BYBLOCK"
      )
      (T
      (set_tile "t_ltype" ltname)
      ltname
      )
   )
   eltype
)
  )
  ;;
  ;; Edit box entries end up here
  ;;
  (defun ltedit_act (ltvalue)
;; If linetype name,is valid, then clear error string,
;; call ltlist_act function, and change focus to list box.
;; Else print error message.
(setq ltvalue (strcase ltvalue))
(if (or (= ltvalue "BYLAYER") (= ltvalue "BY LAYER"))
   (setq ltvalue "BYLAYER")
)
(if (or (= ltvalue "BYBLOCK") (= ltvalue "BY BLOCK"))
   (setq ltvalue "BYBLOCK")
)
(if (setq lt-idx (getindex ltvalue ltnmlst))
   (progn
      (set_tile "error" "")
      (ltlist_act (itoa lt-idx))
      (mode_tile "list_lt" 2)
   )
   (progn
      (if (/= ltvalue "VARIES")
      (set_tile "error" "Invalid linetype.")
      )
      (setq lt-idx old-idx)
   )
)
  )
  ;;
  ;; List selections end up here
  ;;
  (defun ltlist_act (index / dashdata)
;; Update the list box, edit box, and color tile
(set_tile "error" "")
(setq lt-idx (atoi index))
(setq ltname (nth lt-idx ltnmlst))
(setq dashdata (nth lt-idx mdashlist))
(col_tile "show_image" 0 dashdata)
(set_tile "list_lt" (itoa lt-idx))
(set_tile "edit_lt" ltname)
  )
  ;;
  ;; Reset to original linetype when cancel it selected
  ;;
  (defun reset-lt ()
(setq lt-idx old-idx)
(done_dialog 0)
  )
  ;;
  ;; This function pops a dialogue box consisting of a list box and edit box to
  ;; allow the user to select or type a layer name.  It returns the layer name
  ;; selected.  It also the status (On, Off, Frozen, etc.) of all layer in the
  ;; drawing.
  ;;
  (defun getlayer (/ old-idx layname on off frozth linetype colname)
;; Load a dialogue from dialogue file
(if (not (new_dialog "setlayer" dcl_id)) (exit))
(start_list "list_lay")
(mapcar 'add_list longlist)       ; initialize list box
(end_list)
;; Display current layer, show initial layer name in edit
;; box, and highlight list box.
(setq old-idx lay-idx)
(if (/= lay-idx nil) (laylist_act (itoa lay-idx)))
(set_tile "cur_layer" (getvar "clayer"))
(action_tile "list_lay" "(laylist_act $value)")
(action_tile "edit_lay" "(layedit_act $value)")
(action_tile "accept" "(test-ok)")
(action_tile "cancel" "(reset-lay)")
(if (= (start_dialog) 1)          ; User pressed OK
   (progn
      (if (= lay-idx nil) (setq layname "Varies"))
      (set_tile "t_layer" layname)
      ; If layer or ltype equals bylayer reset their tiles
      (if (= lt-idx 0)
      (set_tile "t_ltype" (bylayer_lt))
      )
      (if (= ecolor 256)
      (progn
         (set_tile "t_color" (bylayer_col))
         (col_tile "show_image" cn nil)
      )
      )
      layname
   )
   elayer
)
  )
  ;;
  ;; Edit box selections end up here
  ;;
  (defun layedit_act (layvalue)
;; Convert layer entry to upper case.  If layer name is
;; valid, clear error string, call (laylist_act) function,
;; and change focus to list box.  Else print error message.
(setq layvalue (strcase layvalue))
(if (setq lay-idx (getindex layvalue laynmlst))
   (progn
      (set_tile "error" "")
      (laylist_act (itoa lay-idx))
   )
   (progn
      (set_tile "error" "Invalid layer name.")
      (setq lay-idx old-idx)
   )
)
  )
  ;;
  ;; List entry selections end up here
  ;;
  (defun laylist_act (index / layinfo color dashdata)
;; Update the list box, edit box, and color tile
(set_tile "error" "")
(setq lay-idx (atoi index))
(setq layname (nth lay-idx laynmlst))
(setq layinfo (tblsearch "layer" layname))
(if (= (logand (cdr (assoc 70 layinfo)) 4) 4)
   (set_tile "error" "Cannot change entity to locked layer.")
   (progn
      (setq color (cdr (assoc 62 layinfo)))
      (setq color (abs color))
      (setq colname (colorname color))
      (set_tile "list_lay" (itoa lay-idx))
      (set_tile "edit_lay" layname)
      (mode_tile "list_lay" 2)
   )
)
  )
  ;;
  ;; Reset to original layer when cancel is selected
  ;;
  (defun reset-lay ()
(setq lay-idx old-idx)
(done_dialog 0)
  )
  ;;
  ;; Checks validity of thickness from edit box. Since (atof) returns 0 when a
  ;; string can't be converted to a real, this routine checks if the first
  ;; character is "0".  It also checks to see if the value equals "Varies".
  ;;
  (defun getthickness (value)
(setq value (strcase value))
(if (or (= value "VARIES")
         (distof value)
      )
   (progn
      (set_tile "error" "")
      (if (= value "VARIES")
      (progn
         (set_tile "eb_thickness" "Varies")
         (setq ethickness nil)
      )
      (progn
         (setq ethickness (distof value))
         (set_tile "eb_thickness" (rtos ethickness))
         ethickness
      )
      )
   )
   (progn
      (set_tile "error" "Invalid thickness.")
      nil
   )
)
  )
  ;;
  ;; This function make a list called laynmlst which consists of all the layer
  ;; names in the drawing.  It also creates a list called longlist which
  ;; consists of strings which contain the layer name, color, linetype, etc.
  ;; Longlist is later mapped into the layer listbox.  Both are ordered the
  ;; same.
  ;;
  (defun makelaylists (/ layname onoff frozth color linetype vpf vpn ss cvpname
                     xdlist vpldata sortlist name templist bit-70
                  )
(if (= (setq tilemode (getvar "tilemode")) 0)
   (progn
      (setq ss (ssget "x" (list (cons 0 "VIEWPORT")
                              (cons 69 (getvar "CVPORT"))
                        )
               )
      )
      (setq cvpname (ssname ss 0))
      (setq xdlist (assoc -3 (entget cvpname '("acad"))))
      (setq vpldata (cdadr xdlist))
   )
)
(setq sortlist nil)
(setq templist (tblnext "LAYER" T))
(while templist
   (setq name (cdr (assoc 2 templist)))
   (setq sortlist (cons name sortlist))
   (setq templist (tblnext "LAYER"))
)
(if (>= (getvar "maxsort") (length sortlist))
   (setq sortlist (acad_strlsort sortlist))
   (setq sortlist (reverse sortlist))
)
(setq laynmlst sortlist)
(setq longlist nil)
(setq layname (car sortlist))
(while layname
   (setq laylist (tblsearch "LAYER" layname))
   (setq color (cdr (assoc 62 laylist)))
   (if (minusp color)
      (setq onoff ".")
      (setq onoff "On")
   )
   (setq color (abs color))
   (setq colname (colorname color))
   (setq bit-70 (cdr (assoc 70 laylist)))
   (if (= (logand bit-70 1) 1)
      (setq frozth "F" fchk laylist)
      (setq frozth ".")
   )
   (if (= (logand bit-70 2) 2)
      (setq vpn "N")
      (setq vpn ".")
   )
   (if (= (logand bit-70 4) 4)
      (setq lock "L")
      (setq lock ".")
   )
   (setq linetype (cdr (assoc 6 laylist)))
   (setq layname (substr layname 1 31))
   (if (= tilemode 0)
      (progn
      (if (member (cons 1003 layname) vpldata)
         (setq vpf "C")
         (setq vpf ".")
      )
      )
      (setq vpf ".")
   )
   (setq ltabstr (strcat layname "\t"
                           onoff "\t"
                           frozth "\t"
                           lock "\t"
                              vpf "\t"
                              vpn "\t"
                        colname "\t"
                        linetype
                  )
   )
   (setq longlist (append longlist (list ltabstr)))
   (setq sortlist (cdr sortlist))
   (setq layname (car sortlist))
)
  )
  ;;
  ;; This function makes 2 lists - ltnmlst & mdashlist.  Ltnmlst is a list of
  ;; linetype names read from the symbol table.  Mdashlist is list consisting
  ;; of lists which define the linetype pattern - numbers that indicate dots,
  ;; dashes, and spaces taken from group code 49.  The list corresponds to the
  ;; order of names in ltnmlst.
  ;;
  (defun makeltlists (/ ltlist ltname)
(setq mdashlist nil)
(setq ltlist (tblnext "LTYPE" T))
(setq ltname (cdr (assoc 2 ltlist)))
(setq ltnmlst (list ltname))

(if (= ltname "CONTINUOUS")
   (setq mdashlist (list "CONT"))
   (setq mdashlist
         (append mdashlist (list (add-mdash ltlist)))
   )
)
(while (setq ltlist (tblnext "LTYPE"))
         (setq ltname (cdr (assoc 2 ltlist)))
         (setq ltnmlst (append ltnmlst (list ltname)))
         (setq mdashlist
            (append mdashlist (list (add-mdash ltlist)))
         )
)
(setq ltnmlst (cons "BYBLOCK" ltnmlst))
(setq mdashlist  (cons nil mdashlist))
(setq ltnmlst (cons "BYLAYER" ltnmlst))
(setq mdashlist  (cons nil mdashlist))
  )
  ;;
  ;; Get all the group code 49 values for a linetype and put them in a list
  ;; (pen-up, pen-down info)
  ;;
  (defun add-mdash (ltlist1 / dashlist assoclist dashsize)
(setq dashlist nil)
(while (setq assoclist (car ltlist1))
   (if (= (car assoclist) 49)
      (progn
      (setq dashsize (cdr assoclist))
      (setq dashlist (cons dashsize dashlist))
      )
   )
   (setq ltlist1 (cdr ltlist1))
)
(setq dashlist (reverse dashlist))
  )
  ;;
  ;; Color a tile, draw linetype, and draw a border around it
  ;;
  (defun col_tile (tile color patlist / x y)
(setq x (dimx_tile tile))
(setq y (dimy_tile tile))
(start_image tile)
(fill_image 0 0 x y color)
(if (= color 7)
   (progn
      (if patlist (drawpattern x (/ y 2) patlist 0))
      (tile_rect 0 0 x y 0)
   )
   (progn
      (if patlist (drawpattern x (/ y 2) patlist 7))
      (tile_rect 0 0 x y 7)
   )
)
(end_image)
  )
  ;;
  ;; Draw a border around a tile
  ;;
  (defun tile_rect (x1 y1 x2 y2 color)
(setq x2 (- x2 1))
(setq y2 (- y2 1))
(vector_image x1 y1 x2 y1 color)
(vector_image x2 y1 x2 y2 color)
(vector_image x2 y2 x1 y2 color)
(vector_image x1 y2 x1 y1 color)
  )
  ;;
  ;; Draw the linetype pattern in a tile.  Boxlength is the length of the image
  ;; tile, y2 is the midpoint of the height of the image tile, pattern is a
  ;; list of numbers that define the linetype, and color is the color of the
  ;; tile.
  ;;
  (defun drawpattern (boxlength y2 pattern color / x1 x2
                  patlist dash)
(setq x1 0 x2 0)
(setq patlist pattern)
(if (= patlist "CONT")
   (progn
      (setq dash boxlength)
      (vi)
      (setq x1 boxlength)
   )
)
(while (< x1 boxlength)
   (if (setq dash (car patlist))
      (progn
      (setq dash (fix (* 30 dash)))
      (cond
         ((= dash 0)
            (setq dash 1)
            (vi)
         )
         ((> dash 0)
            (vi)
         )
         (T
            (if (< (abs dash) 2) (setq dash 2))
            (setq x2 (+ x2 (abs dash)))
         )
      )
      (setq patlist (cdr patlist))
      (setq x1 x2)
      )
      (setq patlist pattern)
   )
)
  )
  ;;
  ;; Draw a dash or dot in image tile
  ;;
  (defun vi ()
(setq x2 (+ x2 dash))
(vector_image x1 y2 x2 y2 color)
  )
  ;;
  ;; This function takes a selection and returns a list of the color, linetype,
  ;; layer, and thickness properties that are common to every entities in the
  ;; selection set - (color linetype layer thickness).  If all entities do not
  ;; share the same property value it returns "Varies" in place of the
  ;; property value.  i.e. ("BYLAYER" "DASHED" "Varies" 0)
  ;;
  (defun getprops (selset / sslen elist color ltype layer
                        thickness go chk-col chk-lt chk-lay chk-th ctr)
(setq sslen (sslength selset))
(setq elist (entget (ssname selset 0)))
(setq color (cdr (assoc 62 elist)))
(if (not color) (setq color 256))
(setq ltype (cdr (assoc 6 elist)))
(if (not ltype) (setq ltype "BYLAYER"))
(setq layer (cdr (assoc 8 elist)))
(setq thickness (cdr (assoc 39 elist)))
(if (not thickness) (setq thickness 0))
(setq go T chk-col T chk-lt T chk-lay T chk-th T ctr 1)

;; Page through the selection set.  When a property
;; does not match, stop checking for that property.
;; If all properties vary, stop paging.

(while (and (> sslen ctr) go)
   (setq elist (entget (setq en (ssname selset ctr))))
   (if chk-col (match-col))
   (if chk-lt (match-lt))
   (if chk-lay (match-lay))
   (if chk-th (match-th))
   (setq ctr (1+ ctr))
   (if (and (not chk-col) (not chk-lt) (not chk-lay) (not chk-th))
      (setq go nil)
   )
)
(list color ltype layer thickness)
  )

  (defun match-col (/ ncolor)
(setq ncolor (cdr (assoc 62 elist)))
(if (not ncolor) (setq ncolor 256))
(if (/= color ncolor)
   (progn
      (setq chk-col nil)
      (setq color nil)
   )
)
  )

  (defun match-lt (/ nltype)
(setq nltype (cdr (assoc 6 elist)))
(if (not nltype) (setq nltype "BYLAYER"))
(if (/= ltype nltype)
   (progn
      (setq chk-lt nil)
      (setq ltype "Varies")
   )
)
  )

  (defun match-lay (/ nlayer)
(setq nlayer (cdr (assoc 8 elist)))
(if (/= layer nlayer)
   (progn
      (setq chk-lay nil)
      (setq layer "Varies")
   )
)
  )

  (defun match-th (/ nthickness)
(setq nthickness (cdr (assoc 39 elist)))
(if (not nthickness) (setq nthickness 0))
(if (/= thickness nthickness)
   (progn
      (setq chk-th nil)
      (setq thickness "Varies")
   )
)
  )

  ;;
  ;; If an item is a member of the list, then return its index number, else
  ;; return nil.
  ;;
  (defun getindex (item itemlist / m n)
(setq n (length itemlist))
(if (> (setq m (length (member item itemlist))) 0)
      (- n m)
      nil
)
  )
  ;;
  ;; This function is called if the linetype is set "BYLAYER". It finds the
  ;; ltype of the layer so it can be displayed beside the linetype button.
  ;;
  (defun bylayer_lt (/ layname layinfo ltype)
(if lay-idx
   (progn
      (setq layname (nth lay-idx laynmlst))
      (setq layinfo (tblsearch "layer" layname))
      (setq ltype (cdr (assoc 6 layinfo)))
      (strcat "BYLAYER (" ltype ")")
   )
   "BYLAYER"
)
  )
  ;;
  ;; This function is called if the color is set "BYLAYER".  It finds the
  ;; color of the layer so it can be displayed  beside the color button.
  ;;
  (defun bylayer_col (/ layname layinfo color)
(if lay-idx
   (progn
      (setq layname (nth lay-idx laynmlst))
      (setq layinfo (tblsearch "layer" layname))
      (setq color (abs (cdr (assoc 62 layinfo))))
      (setq cn color)
      (strcat "BYLAYER (" (colorname color) ")")
   )
   (progn
      (setq cn 0)
      "BYLAYER"
   )
)
  )
  ;;
  ;; If there is no error message, then close the dialogue
  ;;
  ;; If there is an error message, then set focus to the tile
  ;; that's associated with the error message.
  ;;
  (defun test-ok ( / errtile)
(setq errtile (get_tile "error"))
(cond
   (  (= errtile "")
      (done_dialog 1))
   (  (= errtile "Invalid thickness.")
      (mode_tile "eb_thickness" 2))
)
  )
  ;;
  ;; A color function used by getlayer.
  ;;
  (defun colorname (colnum)
(setq cn (abs colnum))
(cond ((= cn 1) "red")
      ((= cn 2) "yellow")
      ((= cn 3) "green")
      ((= cn 4) "cyan")
      ((= cn 5) "blue")
      ((= cn 6) "magenta")
      ((= cn 7) "white")
      (T (itoa cn))
)
  )

;;; Construct layer and ltype lists and initialize all
;;; program variables:

  (makelaylists)                   ; layer list - laynmlst
  (makeltlists)                   ; linetype lists - ltnmlst, mdashlist
  ;; Find the property values of the selection set.
  ;; (getprops ss) returns a list of properties from
  ;; a selection set - (color ltype layer thickness).
  (setq proplist (getprops ss))
  (setq ecolor (car proplist))
  (setq eltype (cadr proplist))
  (setq elayer (caddr proplist))
  (setq ethickness (cadddr proplist))
  ;; Find index of linetype, and layer lists
  (cond
((= eltype "Varies") (setq lt-idx nil))
; ((= eltype "BYLAYER") (setq lt-idx (getindex "BYLAYER" ltnmlst)))
; ((= eltype "BYBLOCK") (setq lt-idx (getindex "BYBLOCK" ltnmlst)))
(T (setq lt-idx (getindex eltype ltnmlst)))
  )
  (if (= elayer "Varies")
   (setq lay-idx nil)
   (setq lay-idx (getindex elayer laynmlst))
  )
  (if (= ethickness "Varies")
   (setq ethickness nil)
  )

) ; end (ddchprop_init)

;;; (ddchprop_select)
;;;
;;; Aquires selection set for DDCHPROP, in one of three ways:
;;;
;;; 1 - Autoselected.
;;; 2 - Prompted for.
;;; 3 - Passed as an argument in a call to (ddchprop <ss> )
;;;
;;; The (ddchprop_select) function also sets the value of the
;;; global symbol AI_SELTYPE to one of the above three values to
;;; indicate the method thru which the entity was aquired.

(defun ddchprop_select ()
(cond
   (  (and ss (eq (type ss) 'pickset))       ; selection set passed to
      (cond                                  ; (ddchprop) as argument
         (  (not (zerop (sslength ss)))    ; If not empty, then
            (setq ai_seltype 3)             ; then return pickset.
            (ai_return ss))))

   (  (ai_aselect))                         ; Use current selection
                                             ; set or prompt for objects

   (t (princ "\nNothing selected.")
      (ai_return nil))
)
)

;;; Define command function.

(defun C:CH ()
(ddchprop nil)
(princ)
)

;;; Main program function - callable as a subroutine.
;;;
;;; (ddchprop <pickset> )
;;;
;;; <pickset> is the selection set of objects to be changed.
;;;
;;; If <pickset> is nil, then the current selection set is
;;; aquired, if one exists.  Otherwise, the user is prompted
;;; to select the objects to be changed.
;;;
;;; Before (ddchprop) can be called as a subroutine, it must
;;; be loaded first.  It is up to the calling application to
;;; first determine this, and load it if necessary.

(defun ddchprop (ss  /

               add-mdash    ecolor       ltedit_act    s
               assoclist    elayer       ltidx          selset
               bit-70       elist          ltlist       set_col_tile
               boxlength    eltype       ltlist1
               bylayer-lt    en             ltlist_act    sortlist
               bylayer_col ethickness    ltname
               bylayer_lt    fchk          ltnmlst       sslen
               call_chp    frozth       ltvalue       templist
               chk-col       getcolor       ltype          temp_color
               chk-lay       getindex       m             test-ok
               chk-lt       getlayer       makelaylists testidx
               chk-th       getltype       makeltlists    testlay
               cmd          getprops       match-col    th-value
               cmdecho       getthickness match-in       thickness
               cn          globals       match-lay    tile
               cnum          go             match-lt       tilemode
               col-idx       index          match-th       tile_rect
               colname       item          match_col    vi
               colnum       item1          mdashlist    vpf
               color       item2          n             vpldata
               colorname    itemlist       name          vpn
               col_def       lay-idx       ncolor       x
               col_tile    layedit_act    nlayer       x1
               ctr          layer          nltype       x2
               cvpname       layinfo       nthickness    xdlist
               dash          laylist       off          y
               dashdata    laylist_act    old-idx       y1
               dashlist    layname       olderr       y2
               dashsize    laynmlst       on             undo_init
               dcl_id       layvalue       onoff
                              linetype       patlist
               ddchprop-err list1          pattern
               longlist    proplist
               lt-idx       reset-lay
               drawpattern ltabstr       reset-lt
            )

  (setq old_cmd (getvar "cmdecho") ; save current setting of cmdecho
      old_error  *error*          ; save current error function
      *error* ai_error             ; new error function
  )

  (setvar "cmdecho" 0)

  (cond
   (  (not (ai_notrans)))                   ; Not transparent?
   (  (not (ai_acadapp)))                   ; ACADAPP.EXP xloaded?
   (  (not (setq dcl_id (ai_dcl "ddchprop")))) ; is .DCL file loaded?
   (  (not (setq ss (ddchprop_select))))    ; objects to modify?

   (t (ai_undo_push)
      (ddchprop_init)                         ; Everything's cool,
      (call_chp)                            ; so proceed!
      (ai_undo_pop)
   )
  )

  (setq *error* old_error)
  (setvar "cmdecho" old_cmd)
  (princ)
)

;;;----------------------------------------------------------------------------

(princ " DDCHPROP loaded.")
(princ)

;;;----------------------------------------------------------------------------

;--------------------------------ddmodify.lsp----------------------------------
; Next available MSG number is 111
; MODULE_ID DDMODIFY_LSP_
;;;----------------------------------------------------------------------------
;;; DDMODIFY.LSP
;;;
;;; Copyright 1997 by Autodesk, Inc.
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and
;;; that both that copyright notice and the limited warranty and
;;; restricted rights notice below appear in all supporting
;;; documentation.
;;;
;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;; UNINTERRUPTED OR ERROR FREE.
;;;
;;; Use, duplication, or disclosure by the U.S. Government is subject to
;;; restrictions set forth in FAR 52.227-19 (Commercial Computer
;;; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;; (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;.
;;;
;;;----------------------------------------------------------------------------
;;; DESCRIPTION
;;;
;;; This function allows the user to get a listing comparable to the LIST
;;; command for most objects.  In addition, most object fields in the
;;; dialogue box are editable.  Points can be specified dynamically by
;;; temporarily dismissing the dialogue box.  Each object has a unique
;;; dialogue.
;;;
;;; Naming conventions
;;; Long function and widget names may use an underscore "_"
;;; in their names to make them easier to read, long variable
;;; names use a dash "-".
;;;----------------------------------------------------------------------------
;;;----------------------------------------------------------------------------
;;; Prefixes in command and keyword strings:
;;;    "."  specifies the built-in AutoCAD command in case it has been
;;;          redefined.
;;;    "_"  denotes an AutoCAD command or keyword in the native language
;;;          version, English.
;;;----------------------------------------------------------------------------
;;;
;;; Avoid (gc)s on load to improve load time.
;;;
(defun do_alloc (/ old_allod new_alloc)
  (setq old_alloc (alloc 2000) new_alloc (alloc 2000))
  (expand (1+ (/ 17000 new_alloc)))
  (alloc old_alloc)
)
(do_alloc)
(setq do_alloc nil)

;;;
;;;
;;; ===========================================================================
;;; ===================== load-time error checking ============================

  (defun ai_abort (app msg)
   (defun *error* (s)
      (if old_error (setq *error* old_error))
      (princ)
   )
   (if msg
   (alert (strcat " Application error: "
                  app
                  " \n\n  "
                  msg
                  "  \n"
            )
   )
   )
   (exit)
  )

;;; Check to see if AI_UTILS is loaded, If not, try to find it,
;;; and then try to load it.  If it can't be found or can't be
;;; loaded, then abort the loading of this file immediately.

  (cond
   (  (and ai_dcl (listp ai_dcl)))       ; it's already loaded.

   (  (not (findfile "ai_utils.lsp"))                   ; find it
      (ai_abort "DDMODIFY"
               (strcat "Can't locate file AI_UTILS.LSP."
                        "\n Check support directory.")))

   (  (eq "failed" (load "ai_utils" "failed"))          ; load it
      (ai_abort "DDMODIFY" "Can't load file AI_UTILS.LSP"))
  )

;;; If we get this far, then AI_UTILS.LSP is loaded and it can
;;; be assumed that all functions defined therein are available.

;;; Next, check to see if ACADAPP.EXP has been xloaded, and abort
;;; if the file can't be found or xloaded.  Note that AI_ACADAPP
;;; does not abort the running application itself (so that it can
;;; also be called from within the command without also stopping
;;; an AutoCAD command currently in progress).

  (if (not (ai_acadapp))             ; defined in AI_UTILS.LSP
   (ai_abort "DDMODIFY" nil)       ; a Nil <msg> supresses
  )                                  ; ai_abort's alert box dialog.

;;; ==================== end load-time operations ===========================

;;; global variables

(setq hatch-elist nil)

;;; If we get this far, both ai_utils.lsp and acadapp.exp are
;;; assumed to be available.

;;; Define and encapsulate all subroutines that are declared
;;; locals of the (ddmodify) function.

(defun ddmodify_init ()
  ;;
  ;; These three functions modify the enitity list for common properties.  Since
  ;; color, ltype, and thickness are absent from the object list when they are
  ;; set to their defaults (i.e. color = bylayer), a simple substitution using
  ;; SUBST is not possible.
  ;;
  (defun modify_properties ()
(emod ecolor 62)
(emod eltype 6)
(emod ethickness 39)
(emod eltscale 48)
(tempmod elayer 8 nil)
  )
  ;;
  ;; This function is used for modifying common properties of the ACIS
  ;; based geometry objects. Thickness is not valid for these objects
  ;; so it is left out.
  ;;
  (defun modify_prop_geom ()
(emod ecolor 62)
(emod eltype 6)
(emod eltscale 48)
(tempmod elayer 8 nil)
  )

  (defun emod (value bit)
(if (= bit 62)
   (progn
      (if (or (= value "BYLAYER")
            (= value "BYLAYER")) (setq value 256))
      (if (or (= value "BYBLOCK")
            (= value "BYBLOCK")) (setq value 0))
   )
)
(if (setq oldlist (cdr (assoc bit elist)))
   (tempmod value bit nil)
   (setq elist (append elist (list (cons bit value))))
)
  )
  ;;
  ;; Resets object list to original values.  Called when the dialogue or
  ;; function is cancelled.
  ;;
  (defun reset ()
(setq elist  old-elist
      ecolor (cdr (assoc 62 old-elist))
      ethickness (cdr (assoc 39 old-elist))
      eltype (cdr (assoc 6 old-elist))
      elayer (cdr (assoc 8 old-elist))
      eltscale (cdr (assoc 48 old-elist))
)
(if (not ecolor) (setq ecolor "BYLAYER"))
(if (not eltype) (setq eltype "BYLAYER"))
(if (not ethickness) (setq ethickness 0))
(if (not eltscale) (setq eltscale 1))
(modify_properties)
(setq reset_flag t)
(entmod elist)
  )
  ;;
  ;; Modify object when dialogue is temporarily dismissed to reflect latest
  ;; settings of dialogue.  It converts the point from current UCS coordinates to
  ;; the proper object coordinates (world or object).
  ;;
  ;; Arguments: value - in current UCS coordinates
  ;;          bit - object code (i.e. 10 for start point)
  ;;          ptype - point type  0=world 1=planar
  ;;
  (defun tempmod (value bit ptype / newpoint)
(cond
   ((= ptype 1) (setq value (trans value 1 ename)))
   ((= ptype 0) (setq value (trans value 1 0)))
)
(setq elist (subst (cons bit value)
                     (assoc bit elist)
                     elist
            )
)
  )
  ;;
  ;; The following functions are called after a dialogue has been temporarily
  ;; dismissed and the user is selecting a point.  If a point is selected the
  ;; object list is modified and new X,Y,Z values set.  If no point is selected
  ;; (null response), then the point is reset back to its previous values.
  ;;
  (defun ver_pt1 (ptype)
(if pt1
   (progn
      (tempmod pt1 10 ptype)
      (entmod elist)
   )
   (setq pt1 (list x1 y1 z1))
)
  )

  ; (move_pt1 <ptype> )
  ;
  ; Called in liew of (ver_pt1) to translate block insertions which
  ; might have variable attributes attached to them.  If the distance
  ; the block is to be moved is < 1e-6, the move is deferred.

  (defun move_pt1 (ptype / basept hi)
(setq basept (trans (cdr (assoc 10 (entget ename))) ename 1))
(cond
   (  (not pt1)
      (setq pt1 (list x1 y1 z1)))

   (  (> 1e-6 (distance pt1 basept)))

   (t (tempmod pt1 10 ptype)
      (setq hi (getvar "highlight"))
      (setvar "highlight" 0)
      (command "._move" ename "" basept pt1)
      (setvar "highlight" hi))
)
  )

  (defun ver_pt2 (ptype)
(if pt2
   (progn
      (tempmod pt2 11 ptype)
      (entmod elist)
   )
   (setq pt2 (list x2 y2 z2))
)
  )

  (defun ver_pt3 (ptype)
(if pt3
   (progn
      (tempmod pt3 12 ptype)
      (entmod elist)
   )
   (setq pt3 (list x3 y3 z3))
)
  )

  (defun ver_pt4 (ptype)
(if pt4
   (progn
      (tempmod pt4 13 ptype)
      (entmod elist)
   )
   (setq pt4 (list x4 y4 z4))
)
  )
  ;; Xline/Ray
  (defun ver_xline_pt1()
(if xline_pt1
   (progn
      ;; convert to WCS.
      (setq value (trans xline_pt1 1 0))
      (setq elist (subst (cons 10 value)
                        (assoc 10 elist)
                        elist
                  )
      )
   )
   (setq xline_pt1 (list xline_x1 xline_y1 xline_z1))
)
  )

  (defun ver_xline_pt2()
(if xline_pt2
   (progn
;;
;; Calculate new Direction Vector WCS
;; x / (sqrt ( (x**2) + (y**2) + (z**2)    ))
(setq temp_dir (trans xline_pt2 1 0))
(setq temp_dir_x (car temp_dir))
(setq temp_dir_y (cadr temp_dir))
(setq temp_dir_z (caddr temp_dir))

(setq temp_xline_pt1 (trans xline_pt1 1 0))
(setq temp_xline_x1 (car temp_xline_pt1))
(setq temp_xline_y1 (cadr temp_xline_pt1))
(setq temp_xline_z1 (caddr temp_xline_pt1))

(setq denom (sqrt (+ (expt (- temp_dir_x temp_xline_x1) 2)
                     (expt (- temp_dir_y temp_xline_y1) 2)
                     (expt (- temp_dir_z temp_xline_z1) 2)
)))
(setq temp_dir_x (/ (- temp_dir_x temp_xline_x1) denom))
(setq temp_dir_y (/ (- temp_dir_y temp_xline_y1) denom))
(setq temp_dir_z (/ (- temp_dir_z temp_xline_z1) denom))
(setq elist (subst (cons 11 (list temp_dir_x temp_dir_y temp_dir_z))
                     (assoc 11 elist)
                     elist
            )
)
(entmod elist)
      (setq xline_x2 (car xline_pt2))
      (setq xline_y2 (cadr xline_pt2))
      (setq xline_z2 (caddr xline_pt2))

   )
   (setq xline_pt2 (list xline_x2 xline_y2 xline_z2))
)
  )

  ;;
  ;; Common properties for all objects
  ;;
  (defun set_tile_props ()
(set_tile "error" "")
(setcolor)
(cond
   ((= eltype "BYLAYER")
      (set_tile "t_ltype" (bylayer_lt)))
   ((= eltype "BYBLOCK")
      (set_tile "t_ltype" "BYBLOCK"))
   (T (set_tile "t_ltype" eltype))
)
(set_tile "t_layer" elayer)
(set_tile "eb_thickness" (ai_rtos ethickness))
(set_tile "eb_ltscale" (ai_rtos eltscale))
(setq which_tiles (ai_common_state etype))
;; Disable tiles if need be...

;; Layer Button and Text Field
(if (/= 1 (logand 1 which_tiles))
   (progn
      (mode_tile "t_layer" 1)
      (mode_tile "b_name" 1)
   )
)
;; Color Button and Text Field
(if (/= 2 (logand 2 which_tiles))
   (progn
      (mode_tile "t_color" 1)
      (mode_tile "b_color" 1)
      (mode_tile "show_image" 1)
   )
)
;; Linetype Button and Text Field
(if (/= 4 (logand 4 which_tiles))
   (progn
      (mode_tile "t_ltype" 1)
      (mode_tile "b_line" 1)
   )
)
;; Linetype Scale Edit Field
(if (/= 8 (logand 8 which_tiles))
   (progn
      (mode_tile "eb_ltscale" 1)
   )
)
;; Thickness Edit Field.
(if (/= 16 (logand 16 which_tiles))
   (progn
      (mode_tile "eb_thickness" 1)
   )
)
  )
  ;;
  ;; XYZ Point values for all enitites
  ;;
  (defun set_tile_pt1 (ptype)
(if (= ptype 0)
   (setq pt1 (trans (cdr (assoc 10 elist)) 0 1))
   (setq pt1 (trans (cdr (assoc 10 elist)) ename 1))
)
(set_tile "x1_pt" (ai_rtos (setq x1 (car pt1))))
(set_tile "y1_pt" (ai_rtos (setq y1 (cadr pt1))))
(set_tile "z1_pt" (ai_rtos (setq z1 (caddr pt1))))
  )
  (defun set_tile_pt2 (ptype)
(if (= ptype 0)
   (setq pt2 (trans (cdr (assoc 11 elist)) 0 1))
   (setq pt2 (trans (cdr (assoc 11 elist)) ename 1))
)
(set_tile "x2_pt" (ai_rtos (setq x2 (car pt2))))
(set_tile "y2_pt" (ai_rtos (setq y2 (cadr pt2))))
(set_tile "z2_pt" (ai_rtos (setq z2 (caddr pt2))))
  )
  (defun set_tile_pt3 (ptype)
(if (= ptype 0)
   (setq pt3 (trans (cdr (assoc 12 elist)) 0 1))
   (setq pt3 (trans (cdr (assoc 12 elist)) ename 1))
)
(set_tile "x3_pt" (ai_rtos (setq x3 (car pt3))))
(set_tile "y3_pt" (ai_rtos (setq y3 (cadr pt3))))
(set_tile "z3_pt" (ai_rtos (setq z3 (caddr pt3))))
  )
  (defun set_tile_pt4 (ptype)
(if (= ptype 0)
   (setq pt4 (trans (cdr (assoc 13 elist)) 0 1))
   (setq pt4 (trans (cdr (assoc 13 elist)) ename 1))
)
(set_tile "x4_pt" (ai_rtos (setq x4 (car pt4))))
(set_tile "y4_pt" (ai_rtos (setq y4 (cadr pt4))))
(set_tile "z4_pt" (ai_rtos (setq z4 (caddr pt4))))
  )
  ;;
  ;; Xline/Ray
  ;;
  (defun set_tile_xline_pt1 ()

(setq xline_pt1 (trans (cdr (assoc 10 elist)) 0 1))

(set_tile "xline_x1" (ai_rtos (setq xline_x1 (car xline_pt1))))
(set_tile "xline_y1" (ai_rtos (setq xline_y1 (cadr xline_pt1))))
(set_tile "xline_z1" (ai_rtos (setq xline_z1 (caddr xline_pt1))))
  )
  (defun set_tile_dirv ()
      ;; Convert 11 group to local UCS (displacement)
(setq dir_pt (trans (cdr (assoc 11 elist)) 0 1 1))

(set_tile "dir_x" (rtos (setq dir_ptx (car dir_pt))))
(set_tile "dir_y" (rtos (setq dir_pty (cadr dir_pt))))
(set_tile "dir_z" (rtos (setq dir_ptz (caddr dir_pt))))
  )
  (defun set_tile_xline_pt2 ()
(if (not xline_pt2)
   ;; Initial second point is Root Point + Direction Vector
   (setq xline_pt2 (mapcar '+ xline_pt1 dir_pt))
)
(set_tile "xline_x2" (ai_rtos (setq xline_x2 (car xline_pt2))))
(set_tile "xline_y2" (ai_rtos (setq xline_y2 (cadr xline_pt2))))
(set_tile "xline_z2" (ai_rtos (setq xline_z2 (caddr xline_pt2))))
  )

  ;;
  ;; Handle for all objects
  ;;
  (defun set_tile_handle ()
(if (setq hand (cdr (assoc 5 elist)))
   (set_tile "Handle" hand)
   (set_tile "Handle" "None")
)
  )
  ;;
  ;; Radius for ARC and CIRCLE
  ;;
  (defun set_tile_rad ()
(setq radius (cdr (assoc 40 elist)))
(set_tile "radius" (ai_rtos radius))
  )
  ;;
  ;; Start angle for ARC
  ;;
  (defun set_tile_stang ()
(setq st_ang (cdr (assoc 50 elist)))
(set_tile "st_ang" (ai_angtos st_ang))
  )
  ;;
  ;; End angle for ARC
  ;;
  (defun set_tile_endang ()
(setq end_ang (cdr (assoc 51 elist)))
(set_tile "end_ang" (ai_angtos end_ang))
  )
  ;;
  ;; Rotation Angle - Text, Attributes, Block insertions and Shapes
  ;;
  (defun set_tile_rot ()
(setq rot (cdr (assoc 50 elist)))
(set_tile "rot" (ai_angtos rot))
  )
  ;;
  ;; Height - Text, Attributes and Shapes
  ;;
  (defun set_tile_hght ()
(setq hght (cdr (assoc 40 elist)))
(set_tile "hght" (ai_rtos hght))
  )
  ;;
  ;; Width Factor - Text, Attributes and Shapes
  ;;
  (defun set_tile_wid ()
(setq wid (cdr (assoc 41 elist)))
(set_tile "wid" (ai_rtos wid))
  )
  ;;
  ;; Obliquing Angle - Text, Attributes and Shapes
  ;;
  (defun set_tile_obl ()
(setq obl (cdr (assoc 51 elist)))
(set_tile "obl" (ai_angtos obl))
  )
  ;;
  ;; Text string
  ;;
  (defun set_tile_text ()
(setq text (cdr (assoc 1 elist)))
(set_tile "t_string" text)
  )
  ;;
  ;; Attribute Tag
  ;;
  (defun set_tile_tag ()
(if (= etype "ATTDEF")
   (progn
      (setq attag (cdr (assoc 2 elist)))
      (set_tile "tag" attag)
   )
)
  )
  ;;
  ;; Attribute Definition
  ;;
  (defun set_tile_prompt ()
(if (= etype "ATTDEF")
   (progn
      (setq atprompt (cdr (assoc 3 elist)))
      (set_tile "prompt" atprompt)
   )
)
  )
  ;;
  ;; Justification setting for Attributes and Text.  Initializes
  ;; popup list box
  ;;
  (defun set_tile_just ()
(setq ha (cdr (assoc 72 elist)))  ; horizontal alignment
(setq va (cdr (assoc 73 elist)))  ; vertical alignment
(setq ha-prev ha)
(if (= etype "ATTDEF")
      (setq va (cdr (assoc 74 elist)))  ; vertical alignment
)
(setq jlist
      (list "Left"       "Center"       "Right"
            "Aligned"    "Middle"       "Fit"
            "Top left" "Top center" "Top right"
            "Middle left" "Middle center" "Middle right"
            "Bottom left" "Bottom center" "Bottom right"
      )
)
(start_list "popup_just")
(mapcar 'add_list jlist)
(end_list)
(set_just_idx)
(set_tile "popup_just" (jlist_act just-idx))
  )
  ;;
  ;; Style setting for Attributes and Text.  Reads symbol table for popup list
  ;; box.
  ;;
  (defun set_tile_style (/ sname style-idx tlist)
(setq tlist (tblnext "STYLE" T)
      slist nil)
(while tlist
   (setq sname (cdr (assoc 2 tlist)))
   (if (and (/= sname "")
            (/= (logand 16 (cdr (assoc 70 tlist))) 16))
      (setq slist (cons sname slist)))
   (setq tlist (tblnext "STYLE")))
(if (>= (getvar "maxsort") (length slist))
      (setq slist (acad_strlsort slist)) ; alphabetize style list
   (setq slist (reverse slist)))    ; or reverse it to put it in DB order

(start_list "style")
(mapcar 'add_list slist)
(end_list)
(setq tstyle (cdr (assoc 7 elist)))
(setq style-idx (getindex tstyle slist))
(set_tile "style" (itoa style-idx))
  )
  ;;
  ;; Text and Attribute setting - upside-down, backwards
  ;;
  (defun set_tile_bk-up ()
(setq bk-up (cdr (assoc 71 elist)))
(if (= (logand bk-up 2) 2)
   (set_tile "bkwd" (itoa (setq bkwd 1)))
   (set_tile "bkwd" (itoa (setq bkwd 0)))
)
(if (= (logand bk-up 4) 4)
   (set_tile "upsd" (itoa (setq upsd 1)))
   (set_tile "upsd" (itoa (setq upsd 0)))
)
  )
  ;;
  ;; Attribute setting - invisible, constant, verify, preset
  ;;
  (defun set_tile_icvp ()
(if (not (setq icvp (cdr (assoc 70 elist))))
   (setq icvp 0)
)
(if (= (logand icvp 1) 1)
   (set_tile "inv" (itoa (setq inv 1)))
   (set_tile "inv" (itoa (setq inv 0)))
)
(if (= (logand icvp 2) 2)
   (set_tile "con" (itoa (setq con 1)))
   (set_tile "con" (itoa (setq con 0)))
)
(if (= (logand icvp 4) 4)
   (set_tile "ver" (itoa (setq vfy 1)))
   (set_tile "ver" (itoa (setq vfy 0)))
)
(if (= (logand icvp 8) 8)
   (set_tile "pre" (itoa (setq pre 1)))
   (set_tile "pre" (itoa (setq pre 0)))
)
  )
  ;;
  ;; Scale factors for block insertions
  ;;
  (defun set_tile_scale (/ temp)
(setq temp (getvar "LUNITS"))
(setvar "LUNITS" 2)
(setq xscale (cdr (assoc 41 elist)))
(set_tile "xscale" (ai_rtos xscale))
(setq yscale (cdr (assoc 42 elist)))
(set_tile "yscale" (ai_rtos yscale))
(setq zscale (cdr (assoc 43 elist)))
(set_tile "zscale" (ai_rtos zscale))
(setvar "LUNITS" temp)
  )
  ;;
  ;; Rows and columns for block insertions
  ;;
  (defun set_tile_rc ()
(setq columns (cdr (assoc 70 elist)))
(set_tile "columns" (itoa columns ))
(setq rows (cdr (assoc 71 elist)))
(set_tile "rows" (itoa rows))
(setq col-sp (cdr (assoc 44 elist)))
(set_tile "col_sp" (ai_rtos col-sp))
(setq row-sp (cdr (assoc 45 elist)))
(set_tile "row_sp" (ai_rtos row-sp))
      (if (/= hasclip T)
            (mode_tile "xcliponoff" 1)
            (set_tile "xcliponoff" (itoa xcliponoff))
      )
  )
  ;;
  ;; Invisible edges for 3DFACE
  ;;
  (defun set_tile_edges ()
(setq f-vis (cdr (assoc 70 elist)))
(if (= (logand f-vis 1) 1)
   (set_tile "edge_1" (setq edge1 "0"))
   (set_tile "edge_1" (setq edge1 "1"))
)
(if (= (logand f-vis 2) 2)
   (set_tile "edge_2" (setq edge2 "0"))
   (set_tile "edge_2" (setq edge2 "1"))
)
(if (= (logand f-vis 4) 4)
   (set_tile "edge_3" (setq edge3 "0"))
   (set_tile "edge_3" (setq edge3 "1"))
)
(if (= (logand f-vis 8) 8)
   (set_tile "edge_4" (setq edge4 "0"))
   (set_tile "edge_4" (setq edge4 "1"))
)
  )
  ;;
  ;; XYZ Point values for polyline vertex
  ;;
  (defun set_tile_vpt (ptype)
(if (= (cdr (assoc 0 vlist)) "LWPOLYLINE")
      (progn
         ;; ctr is 1 based, vertices are zero based.
         (setq vpt (cdr (getLwVert (- ctr 1))))
         (set_tile "xtext" (rtos (setq x1 (car vpt))))
         (set_tile "ytext" (rtos (setq y1 (cadr vpt))))
         (set_tile "ztext" (rtos (setq z1 (caddr vpt))))
      )
      (progn
         (if (= ptype 0)
            (setq vpt (trans (cdr (assoc 10 vlist)) 0 1))
            (setq vpt (trans (cdr (assoc 10 vlist)) ename 1))
         )

         (set_tile "xtext" (rtos (setq x1 (car vpt))))
         (set_tile "ytext" (rtos (setq y1 (cadr vpt))))
         (set_tile "ztext" (rtos (setq z1 (caddr vpt))))
      )
)

  )
  ;; This is the equivalent to doing an entnext on the heavy weight
  ;; polylines. The hard coded '4' below allow stepping over the
  ;; 40 41 and 42 group code information. The while loop finds the
  ;; first vertex which will be used as the starting assoc in the
  ;; call to nth.
  ;;
  (defun getLwVert (tmpctr / count tmp)
(setq count 0)
(while (/= (car (nth count vlist)) 10)
      (setq count (+ count 1))
)
;; If the counter reaches the number of vertices,
;; reset ctr and tmpctr to zero again.
(if (= tmpctr (cdr (assoc 90 vlist)))
      (progn
      (setq ctr 0)
      (setq tmpctr 0)
      )
)
(setq tmp (nth (+ count (* tmpctr 4)) vlist))
(setq tmp (append tmp (list(cdr (assoc 38 vlist)))))
(setq pt1 (trans (cdr tmp) (cdr (assoc -1 vlist)) 1))
(setq tmp (cons 10 pt1))
(setq tmp tmp)
  )
  ;;
  ;; Set tiles for Spline properties. If the spline is rational then we
  ;; need to display the weight values of the control points, so set
  ;; flag to 1.
  ;; 1 = rational spline
  ;; 0 = non-rational spline
  ;;
  (defun set_tile_spline_props ()
(setq rational_spl_flag 0)    ;; initialize rational spline flag
(set_tile "Degree" (itoa (cdr (assoc 71 elist))))
(setq bit70 (cdr (assoc 70 elist)))
(if (= (logand bit70 1) 1)
      (set_tile "SpProp4" "Closed")
      (set_tile "SpProp4" "    ")
)
(if (= (logand bit70 2) 2)
      (set_tile "SpProp3" "Periodic")
      (set_tile "SpProp3" "Non-Periodic")
)
(if (= (logand bit70 4) 4)
   (progn
      (set_tile "SpProp2" "Rational")
      (setq rational_spl_flag 1)    ;; this is a rational spline
   )
      (set_tile "SpProp2" "Non-Rational")
)
(if (= (logand bit70 8) 8)
      (set_tile "SpProp1" "Planar")
      (set_tile "SpProp1" "Non-Planar")
)
(if (= (logand bit70 16) 16)
      (set_tile "SpProp5" "Linear")
      (set_tile "SpProp5" "    ")
)
  )
  ;;
  ;; XYZ Point values for spline points
  ;; Need to account for WCS/UCS
  ;;
  (defun set_tile_cntl_pt ()
(setq cntl-pt (cdr (assoc 10  elist)))
(set_tile "xtext" (rtos (setq x1 (car cntl-pt))))
(set_tile "ytext" (rtos (setq y1 (cadr cntl-pt))))
(set_tile "ztext" (rtos (setq z1 (caddr cntl-pt))))
(if (= rational_spl_flag 1)    ;; if rational spline
   (progn                      ;; show weight
      (setq weight (cdr (assoc 41 elist)))
      (set_tile "weight" (rtos weight))
   )                            ;; else
      (mode_tile "weight_text" 1)  ;; disable weight field
)
  )
  ;;
  ;; XYZ Point values for spline points
  ;; Need to account for WCS/UCS
  ;;
  (defun set_tile_data_pt ()
(if (not (assoc 11 elist))
   (mode_tile "data_pts" 1)
   (progn
      (setq data-pt (cdr (assoc 11  elist)))
      ;; display points with current precision.
      (set_tile "dxtext" (rtos (setq x1 (car data-pt))))
      (set_tile "dytext" (rtos (setq y1 (cadr data-pt))))
      (set_tile "dztext" (rtos (setq z1 (caddr data-pt))))
   )
)
  )
  ;;
  ;; Fit curve, fit spline, or smooth spline surface setting
  ;;
  (defun set_tile_fitsmooth ()
(cond
   ((= (cdr (assoc 0 elist)) "LWPOLYLINE")
      (set_tile "none" "1")
   )
   ((= (logand bit70 4) 4)
   (cond
      ((= bit75 0)
         (set_tile "none" "1")
         (setq spltype 0)
      )
      ((= bit75 5)
         (set_tile "quad" "1")
         (setq spltype 5)
      )
      ((= bit75 6)
         (set_tile "cubic" "1")
         (setq spltype 6)
      )
      ((= bit75 8)
         (set_tile "bezier" "1")
         (setq spltype 8)
      )
   )
   )
   ((= (logand bit70 2) 2)
      (set_tile "fit" "1")
      (setq spltype 1)
   )
   (T (set_tile "none" "1"))
)
  )
  ;;
  ;; Closed or Open mesh and polyline setting
  ;;
  (defun set_tile_closed ()
   (if (= pltype "3D mesh")
      (progn
      (if (= (logand bit70 32) 32)
         (set_tile "closedn" (setq closedn "1"))
         (set_tile "closedn" (setq closedn "0"))
      )
      (if (= (logand bit70 1) 1)
         (set_tile "closedm" (setq closed "1"))
         (set_tile "closedm" (setq closed "0"))
      )
      (setq old-closedm closedm old-closedn closedn)
      )
   )
   (if (or (= pltype "2D polyline")
            (= pltype "3D polyline")
      )
      (progn
      (if (= (logand bit70 1) 1)
         (set_tile "closed" (setq closed "1"))
         (set_tile "closed" (setq closed "0"))
      )
      (setq old-closed closed)
      )
   )
  )
  ;; Set common action tiles
  ;;
  ;; Defines action to be taken when pressing various widgets.  It is called
  ;; for every object dialogue.  Not all widgets exist for each object dialogue,
  ;; but defining an action for a non-existent widget does no harm.
  (defun set_action_tiles ()
(action_tile "cancel"    "(dismiss_dialog 0)")
(action_tile "accept"    "(dismiss_dialog 1)")
(action_tile "help"       "(help \"\" help_entry)")
(action_tile "b_color"    "(getcolor)")
(action_tile "show_image" "(getcolor)")
(action_tile "b_name"    "(setq elayer (getlayer))")
(action_tile "b_line"    "(setq eltype (getltype))")
(action_tile "eb_thickness" "(getthickness $value)")
(action_tile "eb_ltscale" "(getltscale $value)")

(action_tile "pick_1"    "(dismiss_dialog 3)")
(action_tile "pick_2"    "(dismiss_dialog 4)")
(action_tile "pick_3"    "(dismiss_dialog 5)")
(action_tile "pick_4"    "(dismiss_dialog 6)")
(action_tile "x1_pt"       "(ver_x1 $value)")
(action_tile "y1_pt"       "(ver_y1 $value)")
(action_tile "z1_pt"       "(ver_z1 $value)")
(action_tile "x2_pt"       "(ver_x2 $value)")
(action_tile "y2_pt"       "(ver_y2 $value)")
(action_tile "z2_pt"       "(ver_z2 $value)")
(action_tile "x3_pt"       "(ver_x3 $value)")
(action_tile "y3_pt"       "(ver_y3 $value)")
(action_tile "z3_pt"       "(ver_z3 $value)")
(action_tile "x4_pt"       "(ver_x4 $value)")
(action_tile "y4_pt"       "(ver_y4 $value)")
(action_tile "z4_pt"       "(ver_4 $value)")

;; Action tiles for Xline & Ray
(action_tile "xline_x1" "(ver_xline_x1 $value)")
(action_tile "xline_y1" "(ver_xline_y1 $value)")
(action_tile "xline_z1" "(ver_xline_z1 $value)")
(action_tile "xline_x2" "(ver_xline_x2 $value)")
(action_tile "xline_y2" "(ver_xline_y2 $value)")
(action_tile "xline_z2" "(ver_xline_z2 $value)")

(action_tile "edge_1"    "(setq edge1 $value)")
(action_tile "edge_2"    "(setq edge2 $value)")
(action_tile "edge_3"    "(setq edge3 $value)")
(action_tile "edge_4"    "(setq edge4 $value)")

(action_tile "radius"    "(ver_rad $value)")
(action_tile "st_ang"    "(ver_ang1 $value)")
(action_tile "end_ang"    "(ver_ang2 $value)")
(action_tile "end_eang"    "(ver_eang $value)")
(action_tile "minrad"    "(ver_minrad $value)")
(action_tile "majrad"    "(ver_majrad $value)")

(action_tile "xscale"    "(ver_xscl $value)")
(action_tile "yscale"    "(ver_yscl $value)")
(action_tile "zscale"    "(ver_zscl $value)")
(action_tile "rot"       "(ver_rot $value)")
(action_tile "columns"    "(ver_col $value)")
(action_tile "rows"       "(ver_row $value)")
(action_tile "col_sp"    "(ver_colsp $value)")
(action_tile "row_sp"    "(ver_rowsp $value)")

(action_tile "hght"       "(ver_hght $value)")
(action_tile "wid"       "(ver_wid $value)")
(action_tile "obl"       "(ver_obl $value)")
(action_tile "style"       "(style_act $value)")

(action_tile "t_string"    "(ddgettext)")
(action_tile "tag"       "(ver_tag)")
(action_tile "prompt"    "(ddgetprompt)")
(action_tile "bkwd"       "(setq bkwd (atoi $value))")
(action_tile "upsd"       "(setq upsd (atoi $value))")
(action_tile "inv"       "(setq inv (atoi $value))")
(action_tile "con"       "(setq con (atoi $value))")
(action_tile "ver"       "(setq vfy (atoi $value))")
(action_tile "pre"       "(setq pre (atoi $value))")
(action_tile "popup_just" "(jlist_act $value)")

(action_tile "closed"    "(setq closed $value)")
(action_tile "ltgen"       "(setq ltgen $value)")
(action_tile "closedm"    "(setq closedm $value)")
(action_tile "closedn"    "(setq closedn $value)")
(action_tile "next_v"    "(next_vertex)")
(action_tile "xcliponoff" "(setq xcliponoff $value)")

(action_tile "next_cntlpt"  "(next_cntl_pt)")
(action_tile "next_datapt"  "(next_data_pt)")

(action_tile "none"       "(if (radio_gaga \"none\")(set_uv 0))")
(action_tile "fit"       "(if (radio_gaga \"fit\")(set_uv 1))")
(action_tile "quad"       "(if (radio_gaga \"quad\")(set_uv 5))")
(action_tile "cubic"       "(if (radio_gaga \"cubic\")(set_uv 6))")
(action_tile "bezier"    "(if (radio_gaga \"bezier\")(set_uv 8))")

(action_tile "u"          "(ver_u $value)")
(action_tile "v"          "(ver_v $value)")
  )

  (defun ddgettext()
(setq text (get_tile "t_string"))
  )

  (defun ddgetprompt()
(setq atprompt (get_tile "prompt"))
  )

  ;; As OW doesn't support disabling of individual radio buttons within
  ;; clusters, a check must be performed as to the legitimacy of the
  ;; button pushed and reset if necessary.
  (defun radio_gaga (pushed)
(cond
   ((and (= pltype "3D polyline")
         (or (= pushed "fit")
            (= pushed "bezier")
         )
   )
      (set_tile "none" "1")
      nil
   )
   ((and (= pltype "3D mesh")
         (= "fit" pushed)
   )
      (set_tile "none" "1")
      nil
   )
   ((= pltype "Polyface mesh")
      (set_tile "none" "1")
      nil
   )
   ((and (= pltype "2D polyline")
         (= "bezier" pushed)
   )
      (set_tile "none" "1")
      nil
   )
   (T)
)
  )
  ;;
  (defun set_uv (type_n)
(setq spltype type_n)
(if (= pltype "3D mesh")
   (if (= spltype 0)
      (progn
      (set_tile "u" (itoa (setq u 0)))
      (set_tile "v" (itoa (setq v 0)))
      )
      (progn
      (if (= u 0)
         (set_tile "u" (itoa (setq u (getvar "surfu"))))
      )
      (if (= v 0)
         (set_tile "v" (itoa (setq v (getvar "surfv"))))
      )
      )
   )
)
  )

  ;;
  ;; Verification functions
  ;;
  ;; Verify distance function.  This takes a new X, Y, or Z coordinate or
  ;; distance value, the tile name, and the previous value as arguments.
  ;; If the distance is valid, it returns the distance and resets the tile.
  ;; Otherwise, it returns the previous value, sets the error tile and keeps
  ;; focus on the tile.  Shifting focus to the tile with invalid value can
  ;; trigger a callback from another tile whose value is valid.  In order
  ;; to keep the error message from being cleared by this secondary callback,
  ;; the variable errchk is set and checked.  The last-tile variable is set
  ;; and checked to ensure the error message is properly cleared when the
  ;; user corrects the value and hits return.
  ;;
  (defun verify_d (tile value old-value / coord valid errmsg)
(setq valid nil errmsg "Invalid input value.")
(if (setq coord (distof value))
   (progn
      (cond
      ((or (= tile "radius")
            (= tile "hght")
            (= tile "wid")
            (= tile "majrad")
            (= tile "minrad")
            (= tile "eb_ltscale")
         )
         (if (> coord 0)
         (setq valid T)
         (setq errmsg "Value must be positive and nonzero.")
         )
      )
      ((or (= tile "xscale")
            (= tile "yscale")
            (= tile "zscale")
         )
         (if (/= coord 0)
         (setq valid T)
         (setq errmsg "Value must be nonzero.")
         )
      )
      (T (setq valid T))
      )
   )
   (setq valid nil)
)
(if valid
   (progn
      (if (or (= errchk 0) (= tile last-tile))
      (set_tile "error" "")
      )
      (set_tile tile (ai_rtos coord))
      (setq errchk 0)
      (setq last-tile tile)
      coord
   )
   (progn
      (mode_tile tile 2)          ; Move focus to offending field
      (mode_tile tile 3)          ; Select offending text
      (set_tile "error" errmsg)
      (setq errchk 1)
      (setq last-tile tile)
      old-value
   )
)
  )
  ;; Function for Xline coord edit box checking.
  (defun verify_xline (tile value old-value / coord valid errmsg)
(setq valid nil errmsg "Invalid input value.")
(if (setq coord (distof value))
   (setq valid T)
   (setq valid nil)
)
(if (and coord
      (and (= (atof (get_tile "xline_x1")) (atof (get_tile "xline_x2")) )
            (= (atof (get_tile "xline_y1")) (atof (get_tile "xline_y2")) )
            (= (atof (get_tile "xline_z1")) (atof (get_tile "xline_z2")) )
      )
      )
   (progn
      (setq errmsg
               "The Root point and the Second point cannot be equal.")
      (setq valid nil)
   )
)
(if valid
   (progn
      (if (or (= errchk 0) (= tile last-tile))
      (set_tile "error" "")
      )
      (set_tile tile (ai_rtos coord))
      (setq errchk 0)
      (setq last-tile tile)
      coord
   )
   (progn
      (mode_tile tile 2)          ; Move focus to offending field
      (mode_tile tile 3)          ; Select offending text
      (set_tile "error" errmsg)
      (setq errchk 1)
      (setq last-tile tile)
      old-value
   )
)
  )

  ;;
  ;; Verify angle function.  This takes an angle and a tile name as arguments.
  ;; If the angle is valid, it returns the angle and resets the tile.
  ;; Otherwise, it sets the error tile and keeps focus on the tile.
  ;;
  (defun verify_a (tile value old-value / ang valid errmsg oblqmax)
(setq valid  nil
      errmsg "Illegal input value."
)
(if (setq ang (angtof value))
   (cond
      ((= tile "obl")             ; Restrict obliquing angle
      (setq oblqmax (+ (* (/ PI 2.0) (/ 85.0 90.0)) 0.000001))
      (if (or (<= ang oblqmax)
               (>= ang (- (* 2.0 PI) oblqmax))
         )
         (setq valid T)
         (setq errmsg
               "Value must be between -85 and +85 degrees.")
      )
      )
      (T (setq valid T))          ; Other angles not restricted
   )
   (setq valid nil)             ; Invalid angle input
)
(if valid
   (progn
      (if (or (= errchk 0) (= tile last-tile))
      (set_tile "error" "")
      )
      (set_tile tile (ai_angtos ang))
      (setq errchk 0)
      (setq last-tile tile)
      ang
   )
   (progn
      (mode_tile tile 2)          ; Move focus to offending field
      (mode_tile tile 3)          ; Select offending text
      (setq last-tile tile)
      (setq errchk 1)
      (set_tile "error" errmsg)
      old-value
   )
)
  )
  ;;
  ;; Verify angle function.  This takes an angle and a tile name as arguments.
  ;; If the angle is valid, it returns the angle and resets the tile.
  ;; Otherwise, it sets the error tile and keeps focus on the tile.
  ;; This function is specifically for the end angle of the ellipse object. If
  ;; the end angle resolves to zero then we want to display it as 360.
  ;;
  (defun verify_ae (tile value old-value / ang tempend)
(if (setq ang (angtof value))
   (progn
      (if (or (= errchk 0) (= tile last-tile))
      (set_tile "error" "")
      )
      (setq tempend (ai_angtos ang))
      (if (= tempend "0")
         (set_tile tile "360")
         (set_tile tile tempend)
      )
      (setq errchk 0)
      (setq last-tile tile)
      ang
   )
   (progn
      (mode_tile tile 2)          ; Move focus to offending field
      (mode_tile tile 3)          ; Select offending text
      (setq last-tile tile)
      (setq errchk 1)
      (set_tile "error" "Illegal input value.")
      old-value
   )
)
  )
  ;;
  ;; Verify integer function.  This takes an integer and a tile name as
  ;; arguments.  If the integer is valid, it returns the integer and resets the
  ;; tile.  Otherwise, it sets the error tile and keeps focus on the tile.
  ;;
  (defun verify_i (tile value old-value / int valid errmsg)
(setq valid nil)
(setq errmsg "Value must be an integer.")
(setq int (atoi value))
(if (setq intchk (distof value))
   (cond
      ((or (= tile "columns") (= tile "rows"))
      (if (and (= int intchk)
               (>= int 0)
               (<= int 32767)
         )
         (setq valid T)
         (setq errmsg "Value must be an integer between 0 and 32767.")
      )
      )
      ((and (or (= tile "u") (= tile "v")))
      (if (and (= int intchk)
               (>= int 0)
               (< int 201)
         )
         (setq valid T)
         (setq errmsg "Value must be an integer between 0 and 200.")
      )
      )
   )
)
(if valid
   (progn
      (if (or (= errchk 0) (= tile last-tile))
         (set_tile "error" "")
      )
      (set_tile tile (itoa int))
      (setq errchk 0)
      (setq last-tile tile)
      int
   )
   (progn
      (mode_tile tile 2)          ; Move focus to offending field
      (mode_tile tile 3)          ; Select offending text
      (set_tile "error" errmsg)
      (setq errchk 1)
      (setq last-tile tile)
      old-value
   )
)
  )
  ;;
  ;; Functions that verify tile values for integers
  ;;
  (defun ver_col (value)
(setq columns (verify_i "columns" value columns))
  )
  (defun ver_row (value)
(setq rows (verify_i "rows" value rows))
  )
  (defun ver_u (value)
(setq u (verify_i "u" value u))
  )
  (defun ver_v (value)
(setq v (verify_i "v" value v))
  )
  ;;
  ;; Functions that verify tile values for reals
  ;;
  (defun ver_x1 (value)
(if (setq x1 (verify_d "x1_pt" value x1)) (calc))
  )
  (defun ver_y1 (value)
(if (setq y1 (verify_d "y1_pt" value y1)) (calc))
  )
  (defun ver_z1 (value)
(if (setq z1 (verify_d "z1_pt" value z1)) (calc))
  )
  (defun ver_x2 (value)
(if (setq x2 (verify_d "x2_pt" value x2)) (calc))
  )
  (defun ver_y2 (value)
(if (setq y2 (verify_d "y2_pt" value y2)) (calc))
  )
  (defun ver_z2 (value)
(if (setq z2 (verify_d "z2_pt" value z2)) (calc))
  )
  (defun ver_x3 (value)
(setq x3 (verify_d "x3_pt" value x3))
  )
  (defun ver_y3 (value)
(setq y3 (verify_d "y3_pt" value y3))
  )
  (defun ver_z3 (value)
(setq z3 (verify_d "z3_pt" value z3))
  )
  (defun ver_x4 (value)
(setq x4 (verify_d "x4_pt" value x4))
  )
  (defun ver_y4 (value)
(setq y4 (verify_d "y4_pt" value y4))
  )
  (defun ver_4 (value)
(setq z4 (verify_d "z4_pt" value z4))
  )
  (defun ver_xscl (value)
(setq xscale (verify_d "xscale" value xscale))
  )
  (defun ver_yscl (value)
(setq yscale (verify_d "yscale" value yscale))
  )
  (defun ver_zscl (value)
(setq zscale (verify_d "zscale" value zscale))
  )
  (defun ver_colsp (value)
(setq col-sp (verify_d "col_sp" value col-sp))
  )
  (defun ver_rowsp (value)
(setq row-sp (verify_d "row_sp" value row-sp))
  )
  (defun xclip ()
(setq xclipmode t)
(if (= xcliponoff "1")
   (command "_.xclip" (cdr(assoc -1 elist)) "" "_on")
   (command "_.xclip" (cdr(assoc -1 elist)) "" "_off")
)
  )
  (defun ver_rad (value)
(if (setq radius (verify_d "radius" value radius))
   (calc)
)
  )
  (defun ver_majrad (value)
(if (setq majrad (verify_d "majrad" value majrad))
   (ell_calc_newval "majrad")
)
  )
  (defun ver_minrad (value)
(if (setq minrad (verify_d "minrad" value minrad))
   (ell_calc_newval "minrad")
)
  )
  (defun ver_hght (value)
(setq hght (verify_d "hght" value hght))
  )
  (defun ver_wid (value)
(setq wid (verify_d "wid" value wid))
  )
  (defun ver_xline_x1 (value / temp)
(setq temp xline_x1)
(setq xline_x1 (verify_xline "xline_x1" value xline_x1))
(if (/= temp xline_x1)
   (progn (modify_xline 0) (set_tile_dirv) )
)
  )
  (defun ver_xline_y1 (value / temp)
(setq temp xline_y1)
(setq xline_y1 (verify_xline "xline_y1" value xline_y1))
(if (/= temp xline_y1)
   (progn (modify_xline 0) (set_tile_dirv) )
)
  )
  (defun ver_xline_z1 (value / temp)
(setq temp xline_z1)
(setq xline_z1 (verify_xline "xline_z1" value xline_z1))
(if (/= temp xline_z1)
   (progn (modify_xline 0) (set_tile_dirv) )
)
  )
  (defun ver_xline_x2 (value / temp)
(setq temp xline_x2)
(setq xline_x2 (verify_xline "xline_x2" value xline_x2))
(if (/= temp xline_x2)
   (progn (modify_xline 0) (set_tile_dirv))
)
  )
  (defun ver_xline_y2 (value / temp)
(setq temp xline_y2)
(setq xline_y2 (verify_xline "xline_y2" value xline_y2))
(if (/= temp xline_y2)
   (progn (modify_xline 0) (set_tile_dirv) )
)
  )
  (defun ver_xline_z2 (value / temp)
(setq temp xline_z2)
(setq xline_z2 (verify_xline "xline_z2" value xline_z2))
(if (/= temp xline_z2)
   (progn (modify_xline 0) (set_tile_dirv) )
)
  )
  ;;
  ;; Functions that verify tile values for angles
  ;;
  (defun ver_ang1 (value)
(if (setq st_ang (verify_a "st_ang" value st_ang))
   (calc)
)
  )
  (defun ver_ang2 (value)
(if (setq end_ang (verify_a "end_ang" value end_ang))
   (calc)
)
  )
  ;;
  ;; Verify tile value for ellipse end angle. Handled slightly
  ;; differently than the other angles.
  ;;
  (defun ver_eang (value)
(setq end_eang (verify_ae "end_eang" value end_eang))
  )
  (defun ver_rot (value)
(setq rot (verify_a "rot" value rot))
  )
  (defun ver_obl (value)
(setq obl (verify_a "obl" value obl))
  )
  ;;
  ;; Function that verifies attribute tag field for null string,
  ;; or a string that contains one or more spaces.  Tile value
  ;; is also converted to upper-case as well.
  ;;
  ;;
  (defun ver_tag ( / tval)
   (setq tagval (get_tile "tag"))
   (set_tile "error" "")
   (cond
      (  (or (eq "" (setq tval (strcase (ai_strtrim tagval))))
            (wcmatch tval "* *"))
         (set_tile "error" "Invalid attribute tag.")
         (mode_tile "tag" 2)
         (mode_tile "tag" 3))
      (t (set_tile "error" "")
         (set_tile "tag" tval)
         (setq attag tval)))
  )
  ;;
  ;; Calculation functions
  ;;
  (defun calc ()
(if (= etype "LINE") (line_calc))
(if (= etype "ARC") (arc_calc))
(if (= etype "CIRCLE") (cir_calc))
  )
  ;;
  ;; Calculation functions for lines, arcs, and circles
  ;;
  (defun line_calc ()
(setq stpt  (list x1 y1 z1))
(setq endpt (list x2 y2 z2))
(set_tile "delta_x" (rtos (- x2 x1)))
(set_tile "delta_y" (rtos (- y2 y1)))
(set_tile "delta_z" (rtos (- z2 z1)))
(set_tile "l_length" (rtos (distance stpt endpt)))
(set_tile "l_angle" (angtos (angle stpt endpt)))
  )

  (defun cir_calc ( / area units)
      (setq radtest radius)
      (set_tile "Dia" (rtos (* 2 radius)))
      (set_tile "Circum" (rtos (* 2 pi radius)))
      (setq area  (* pi (* radius radius)))
      (setq units (getvar "LUNITS"))
      (if (or (= units 3) (= units 4))
         (progn
            (setq area (/ area 144.0))
            (set_tile "Area" (strcat (rtos area 2) " square ft"))
         )
         (set_tile "Area" (rtos area))
      )
  )

  (defun arc_calc ()
(setq totang (- end_ang st_ang))
(while (< totang 0)
   (setq totang (+ totang (* 2 pi)))
)
(while (> totang (* 2 pi))
   (setq totang (- totang (* 2 pi)))
)
(set_tile "tot_angle" (angtos totang))
(setq arclen (* (* 2 pi radius) (/ totang (* 2 pi))))
(set_tile "arclen" (rtos arclen))
  )
  ;;
  ;; Calculate the major radius, minor radius, major axis direction.
  ;; Get radius ratio. Convert Start, end parameters to start and end
  ;; angles. Save Major Radius value in "old_majrad" in case the user
  ;; chooses to input a new Major Radius value later. It's needed to
  ;; calculate a new Major Axis Vector value.
  ;;
  (defun ell_calc ()
      ;; Get major radius from the major axis vector.
      (setq majaxis (cdr (assoc 11 elist)))
      (setq xx (car majaxis))
      (setq yy (cadr majaxis))
      (setq zz (caddr majaxis))
      (setq majrad (sqrt (+ (* xx xx) (* yy yy) (* zz zz) )))
      (set_tile "majrad" (ai_rtos majrad))
      (setq old_majrad majrad)
      ;; Get radius ratio
      (setq rrat (cdr (assoc 40 elist)))
      (set_tile "rratio" (rtos rrat))
      ;; Calculate minor radius
      (setq minrad (* majrad rrat))
      (set_tile "minrad" (ai_rtos minrad))
      ;; display major axis vector
      (set_tile "Majraddirx" (rtos xx))
      (set_tile "Majraddiry" (rtos yy))
      (set_tile "Majraddirz" (rtos zz))

      ;; Convert start parm to start angle
      (setq stparm (cdr (assoc 41 elist)))
      (setq vecx (cos stparm))
      (setq vecy (sin stparm))
      (setq st_ang (atan (* rrat vecy) vecx))
      (setq tempst_ang (ai_angtos st_ang))
      (set_tile "st_ang" tempst_ang)
      ;; Convert end parm to end angle. If end angle evaluates to 0
      ;; degrees then display it as 360 degrees.
      (setq endparm (cdr (assoc 42 elist)))
      (setq evecx (cos endparm))
      (setq evecy (sin endparm))
      (setq end_eang (atan (* rrat evecy) evecx))
      (setq tempend_eang (ai_angtos end_eang))
      (if (= tempend_eang "0")
         (set_tile "end_eang" "360")
         (set_tile "end_eang" tempend_eang)
      )
      ;; Get area of the ellipse.
      (ell_calc_area)
  )
  ;; Calculate area of ellipse. If it is an arc then
  ;; grey out area display.
  ;;
  (defun ell_calc_area ( / area units)
   (if (and (= tempst_ang "0") (= tempend_eang "0"))
      (progn
         (setq area  (* pi majrad minrad))
         (setq units (getvar "LUNITS"))
         (if (or (= units 3) (= units 4))
               (progn
                  (setq area (/ area 144.0))
                  (set_tile "Area" (strcat (rtos area 2)" square ft"))
               )
               (set_tile "Area" (rtos area))
         )
      )
      (mode_tile "Area_text" 1)
   )
  )
  ;;
  ;; Calculate new values for ELLIPSE
  ;; Minor Radius, Area
  ;;
  (defun ell_calc_newval (ell_tile)
(if (= ell_tile "majrad")
   (progn
      (setq rrat (/ minrad majrad))
      (set_tile "rratio" (rtos rrat))
      (ell_calc_area)
   )
)
(if (= ell_tile "minrad")
   (progn
      (setq rrat (/ minrad majrad))
      (set_tile "rratio" (rtos rrat))
      (ell_calc_area)
   )
)
  )

  (defun set_dimen_props (/ loop a stl txstyname)

(setq stname (cdr (assoc 3 elist)) ; get style name
      stl (tblnext "DIMSTYLE" T)
      stlist nil)
;; Get all style names and list them in alphabetical order
(while stl
   (setq sname (cdr (assoc 2 stl)))
   (if (/= (logand 16 (cdr (assoc 70 stl))) 16)
         (setq stlist (cons sname stlist)))
   (setq stl (tblnext "DIMSTYLE")))

(setq len (length stlist)
      loop 0
      dimsty stname
)

;; alphabetize style list, depending on maxsort
(if (>= (getvar "maxsort") len)
      (setq stlist (acad_strlsort stlist))
   (setq stlist (reverse stlist)))

; *UNNAMED style (dimsty = nil at this point) is replaced with
; the current style.  After R13, we require dimensiosn to have a
; dimstyle, so we plug any holes where we find them.
(if (null dimsty)
   (setq dimsty (getvar "dimstyle"))
)
; Show the styles in combo box
(start_list "mod_style" 2)
(while (< loop len)
   (add_list (nth loop stlist))
   (setq loop (1+ loop))
)

(end_list)

; Hilight the style name of the selected entity
(while (and (< 0 loop) (/= dimsty (nth loop stlist)))
   (setq loop (1- loop))
)
(set_tile "mod_style" (itoa loop))

; The following is the list dimvars. It must be sorted in the same
; order as the resfub returned from DDIM (ADS module).

(setq dimtbl (list "DIMSTYLE"  "Style name"  "Standard flag values"
      "dimpost" "dimapost" "dimblk" "dimblk1" "dimblk2"
      "dimscale"  "dimasz"    "dimexo" "dimdli"    "dimexe"
      "dimrnd" "dimdle"    "dimtp"    "dimtm"    "dimtxt"
      "dimcen" "dimtsz"    "dimaltf" "dimlfac" "dimtvp"
      "dimtfac" "dimgap"    "dimtol" "dimlim"    "dimtih"
      "dimtoh" "dimse1"    "dimse2" "dimtad"    "dimzin"
      "dimalt" "dimaltd"    "dimtofl" "dimsah"    "dimtix"
      "dimsoxd" "dimclrd"    "dimclre" "dimclrt" "dimunit"
      "dimdec" "dimtdec"    "dimaltu" "dimalttd"
      "dimaunit"  "dimjust"    "dimsd1" "dimsd2"    "dimtolj"
      "dimtzin" "dimaltz"    "dimalttz"  "dimfit"    "dimupt"
      "dimtxsty"
))
(progn
      (setq sv_dvlist (ddimen_getostate dimsty)
            txstyname (assoc 340 sv_dvlist)
            sv_dvlist (subst (cons 340 (tblobjname "STYLE" (cdr txstyname)))
                              txstyname sv_dvlist)
            dimlist sv_dvlist
      )
)
(if (= dimtype "DDLEADER")
   (mode_tile "mod_format" 1)
)
(action_tile "mod_style" "(setq dimsty (ddimen_style))")
(action_tile "mod_text"  "(done_dialog 4)")
(action_tile "mod_geom" "(setq dimlist (ddimen_dlg dimtype 11 dimsty dimlist))")
(action_tile "mod_format" "(setq dimlist (ddimen_dlg dimtype 12 dimsty dimlist))")
(action_tile "mod_annot" "(setq dimlist (ddimen_dlg dimtype 13 dimsty dimlist))")
(action_tile "accept" "(done_dialog 1)")
  )
  ;;
  ;; Get dimvars that have been restored.
  ;;
  (defun ddimen_getvars (/ elm dvlist dv i)
(setq i 3
      dvlist (list (cons 0 "DIMSTYLE")
               (cons 2 (getvar "dimstyle")) (cons 70 0))
)
(while (setq dv (nth i dimtbl))
   (setq elm (getvar dv)
         dvlist (append dvlist (list (cons dv elm)))
         i (1+ i)
   )
)
dvlist
  )

  ;;
  ;; Get the original states of dimvars. This is for DIMENSION entities.
  ;;
  (defun ddimen_getostate (dimsty / dvlist elm i dvvars)
(setq dvlist (tblnext "dimstyle" T) ; Get a skelton list
      dvvars (ddimen_getvars)    ; Get dimvars for that entity
      i 1
)

; Create a list that contains values of the selected entity.

(while (setq elm (nth i dvlist))
   (setq dvlist (subst (cons (car elm) (cdr (nth i dvvars))) elm dvlist)
         i (1+ i)
   )
)
dvlist
  )

  ;;
  ;; Restores dimvars of the selected enity.
  ;;
  (defun ddimen_dimsty_restore(/ dimtbl dimsvcurset en)
(setq dimtbl (list "DIMSTYLE"  "Style name"  "Standard flag values"
      "dimpost" "dimapost" "dimblk" "dimblk1" "dimblk2"
      "dimscale"  "dimasz"    "dimexo" "dimdli"    "dimexe"
      "dimrnd" "dimdle"    "dimtp"    "dimtm"    "dimtxt"
      "dimcen" "dimtsz"    "dimaltf" "dimlfac" "dimtvp"
      "dimtfac" "dimgap"    "dimtol" "dimlim"    "dimtih"
      "dimtoh" "dimse1"    "dimse2" "dimtad"    "dimzin"
      "dimalt" "dimaltd"    "dimtofl" "dimsah"    "dimtix"
      "dimsoxd" "dimclrd"    "dimclre" "dimclrt" "dimunit"
      "dimdec" "dimtdec"    "dimaltu" "dimalttd"
      "dimaunit"  "dimjust"    "dimsd1" "dimsd2"    "dimtolj"
      "dimtzin" "dimaltz"    "dimalttz"  "dimfit"    "dimupt"
      "dimtxsty"
))
(setq dimsvcurset (ddimen_getvars))  ; Save current variable settings
(progn
      (setq en (cdr (assoc -1 elist)))
      (command "_.dimstyle" "" "" en)
)
dimsvcurset
  )
  ;;
  ;; Modify Leader
  ;;
  (defun ddleader (/ dtypebit blkname bename sublist a  stname n dimtbl
               dimsty dimlist dimtext svtext dimovr sv_dvlist stlist
               dimtype dimsvcurset)
(setq dimtype "DDLEADER"
      dimsvcurset (ddimen_dimsty_restore)
)
(if (not (new_dialog "ddleader" dcl_id)) (exit))
;; Set initial tile values
(set_tile_props)
(set_dimen_props)
(set_tile_handle)
;; Define action for tiles
(set_action_tiles)
(mode_tile "mod_text" 1)

(action_tile "mod_style" "(setq dimsty (ddimen_style))")
(action_tile "accept" "(setq leadtype (get_tile \"s-s\"))(setq arrow (get_tile \"arrow\"))(done_dialog 1)")
;; Get ARROW and TYPE.
(if (= 1 (logand (cdr (assoc '71 elist)))) (set_tile "arrow" "1"))
(if (= 1 (logand (cdr (assoc '72 elist))))
   (set_tile "s-s" "spline")
   (set_tile "s-s" "straight")
)
;; Start the dialogue.
(setq dialog-state (start_dialog))
(if (= dialog-state 1)
   (progn
      ;; update the style
      (if (/= dimsty stname)
      (progn
         ; Be sure to add (3 . dimstylename) element. R12 *UNNAMED case
         ; doesn't have it.
         (if (null (assoc 3 elist))
            (setq elist (append elist (list (cons 3 dimsty))))
            ; else just replace it.
            (setq elist (subst (cons 3 dimsty) (assoc 3 elist) elist))
         )
         ; refresh sv_dvlist with new dimstyle.
         (setq sv_dvlist (tblsearch "dimstyle" dimsty))
      )
      )
      (if (not (null dimlist)) ; attempted to change dimvars
      (ddimen_complist sv_dvlist dimlist dimtbl)
      )
      ;; update for ARROW.
      (if (= "1" arrow)
      (setq elist (subst (cons 71 (logior 1 (cdr (assoc 71 elist)))) (assoc 71 elist) elist))
      (setq elist (subst (cons 71 (logand (~ 1) (cdr (assoc 71 elist)))) (assoc 71 elist) elist))
      )
      ;; update the TYPE.
      (if (= "spline" leadtype)
      (setq elist (subst (cons 72 (logior 1 (cdr (assoc 72 elist)))) (assoc 72 elist) elist))
      (setq elist (subst (cons 72 (logand (~ 1) (cdr (assoc 72 elist)))) (assoc 72 elist) elist))
      )
      (modify_prop_geom)
      ;; update the Color
      (setq elist (subst (cons 77 ecolor) (assoc 77 elist) elist))
      (entmod elist)
   )
)
(ddimen_setvars dimsvcurset)    ; Prepare to exit
  )

  ;;
  ;; Get dimvars of a dimstyle with overrides.
  ;;

  (defun ddimen_getdimvars (dimsty / dimovr dvlist elm i)

;; Get override information for the specified entity.
;; Leader/Tolerance cannot be restored by DIMSTYLE command, so we
;; must obtain override information through this tedious operation.
(setq dimovr (car (cdr (assoc -3 (entget (cdr (assoc -1 elist)) (list "*")))))
      dvlist (tblsearch "dimstyle" dimsty)
      i 2
)

; Update the list with overrides if overrides exist.

(if (and dimovr (= "DSTYLE" (cdr (nth 1 dimovr))))
   (progn
      (while (setq elm (cdr (nth i dimovr)))
      (progn
         (if (or (= elm "{") (= elm "}"))
            (setq i (1+ i))
            (progn
            (if (or (and (< 180 elm)
                           (< elm 190)
                     )
                     (and (< 80 elm)
                           (< elm 90)
                     )
                  )
               (setq elm (- elm 10))
            )
            (setq i (1+ i)
                  elm (cons elm (cdr (nth i dimovr)))
                  dvlist (subst elm (assoc (car elm) dvlist) dvlist)
                  i (1+ i)
            )
            )
         )
      )
      )
   )
)
dvlist
  )

  ;;
  ;; Modify POINT
  ;;
  (defun modify_point ()
(modify_properties)
(setq pt1 (list x1 y1 z1))
(tempmod pt1 10 0)
(entmod elist)
  )

  (defun ddpoint ()
(if (not (new_dialog "ddpoint" dcl_id)) (exit))
;; Set initial tile values
(set_tile_props)
(set_tile_handle)
(set_tile_pt1 0)
;; Define action for tiles
(set_action_tiles)
(setq dialog-state (start_dialog))
(if (= dialog-state 0)
   (reset)
)
(if (= dialog-state 3)
   (progn
      (modify_point)
      (setq pt1 (getpoint (list x1 y1 z1)  "\nPoint: "))
      (ver_pt1 0)
      (ddpoint)
   )
)
(if (= dialog-state 1)
   (modify_point)
)
  )
  ;;
  ;; Modify LINE
  ;;
  (defun modify_line ()
(modify_properties)
(setq pt1 (list x1 y1 z1))
(setq pt2 (list x2 y2 z2))
(tempmod pt1 10 0)
(tempmod pt2 11 0)
(entmod elist)
  )
  (defun ddline ()
(if (not (new_dialog "ddline" dcl_id)) (exit))
;; Set initial tile values
(set_tile_props)
(set_tile_handle)
(set_tile_pt1 0)
(set_tile_pt2 0)
(line_calc)
;; Define action for tiles
(set_action_tiles)
(setq dialog-state (start_dialog))
(if (= dialog-state 0)
   (reset)
)
(if (= dialog-state 3)
   (progn
      (modify_line)
      (setq pt1 (getpoint (list x2 y2 z2)  "\nFrom point: "))
      (ver_pt1 0)
      (ddline)
   )
)
(if (= dialog-state 4)
   (progn
      (modify_line)
      (setq pt2 (getpoint (list x1 y1 z1) "\nTo point: "))
      (ver_pt2 0)
      (ddline)
   )
)
(if (= dialog-state 1)
   (modify_line)
)
  )
  ;;
  ;; Modify MLine
  ;;
  (defun modify_mline ()
(modify_properties)
(entmod elist)
  )
  (defun ddmline ()
(if (not (new_dialog "ddmline" dcl_id)) (exit))
;; Set initial tile values
(set_tile_props)
(set_tile_handle)
;; Set mline style text field.
(set_tile "ml_style" (cdr (assoc '2 elist)))

;; Define action for tiles
(set_action_tiles)
(action_tile "ml_edit" "(done_dialog 3)")
(setq dialog-state (start_dialog))
;; Dialog cancelled, reset to original values.
(if (= dialog-state 0)
   (reset)
)
;; Dialog OKed, update the mline.
(if (= dialog-state 1)
   (modify_mline)
)
;; Edit Mline, call MLEDIT.
(if (= dialog-state 3)
   (progn
      (modify_mline)
      (command "_mledit")
      (ddmline)
   )
)
  )
  ;;
  ;; Modify Xline
  ;;
  (defun modify_xline (flag)
(modify_prop_geom)
(setq xline_pt1 (list xline_x1 xline_y1 xline_z1))
(setq xline_pt2 (list xline_x2 xline_y2 xline_z2))
;; Update the Root point.
(setq elist (subst (cons 10 (trans xline_pt1 1 0))
                     (assoc 10 elist)
                     elist
            )
)
;;
;; Calculate new Direction Vector WCS
;; x / (sqrt ( (x**2) + (y**2) + (z**2)    ))

(setq temp_dir (trans xline_pt2 1 0))
(setq temp_dir_x (car temp_dir))
(setq temp_dir_y (cadr temp_dir))
(setq temp_dir_z (caddr temp_dir))

(setq temp_xline_pt1 (trans xline_pt1 1 0))
(setq temp_xline_x1 (car temp_xline_pt1))
(setq temp_xline_y1 (cadr temp_xline_pt1))
(setq temp_xline_z1 (caddr temp_xline_pt1))

(setq denom (sqrt (+ (expt (- temp_dir_x temp_xline_x1) 2)
                     (expt (- temp_dir_y temp_xline_y1) 2)
                     (expt (- temp_dir_z temp_xline_z1) 2)
)))
(setq temp_dir_x (/ (- temp_dir_x temp_xline_x1) denom))
(setq temp_dir_y (/ (- temp_dir_y temp_xline_y1) denom))
(setq temp_dir_z (/ (- temp_dir_z temp_xline_z1) denom))
(setq elist (subst (cons 11 (list temp_dir_x temp_dir_y temp_dir_z))
                     (assoc 11 elist)
                     elist
            )
)
(if (= 1 flag)
   (entmod elist)
)
  )

  (defun ddxline ()
(if (= etype "XLINE")
   (if (not (new_dialog "ddxline" dcl_id)) (exit))
   (if (not (new_dialog "ddray" dcl_id)) (exit))
)
;; Set initial tile values
(set_tile_props)
(set_tile_handle)
(set_tile_xline_pt1)
;; Convert to UCS and post Direction vector.
(set_tile_dirv)
;; Calculate second point by adding Root Point + Direction Vector.
(set_tile_xline_pt2)
;; Define action for tiles
(set_action_tiles)
(setq dialog-state (start_dialog))
(if (= dialog-state 0)
   (reset)
)
(if (= dialog-state 3)
   (progn
      (modify_xline 1)
      (while (equal xline_pt2
      (setq xline_pt1 (getpoint xline_pt2 "\nRoot point: ")) 0.000001)
      (princ "The Root point cannot equal the Second point.")
      )
      (ver_xline_pt1)
      (ver_xline_pt2)
(princ)
      (ddxline)
   )
)
(if (= dialog-state 4)
   (progn
      (modify_xline 1)
      (while (equal xline_pt1
      (setq xline_pt2 (getpoint xline_pt1 "\nSecond point: ")) 0.000001)
      (princ "The Second point cannot equal the Root point.")
      )
      (ver_xline_pt2)
(princ)
      (ddxline)
   )
)
(if (= dialog-state 1)
   (modify_xline 1)
)
  )
  ;;
  ;; Modify ELLIPSE
  ;;
  (defun modify_ellipse ()
(modify_prop_geom)
;; Update Ellipse Center Point value.
(setq pt1 (list x1 y1 z1))
(tempmod pt1 10 1)
;; Update Start Parameter value.
(setq y_val (sin st_ang))
(setq x_val (* rrat (cos st_ang)))
(setq stparm (atan y_val x_val))
(setq elist (subst (cons 41 stparm) (assoc 41 elist) elist ))
;; Update End Parameter value. Normalize it, if it's less than
;; the start parameter.
(setq y_eval (sin end_eang))
(setq x_eval (* rrat (cos end_eang)))
(setq endparm (atan y_eval x_eval))
(setq diffparm (- endparm stparm))
;; Epsilon of 1.0e-6 radians for checking a zero length arc.
;; Since zero length arcs are not allowed - construct the full
;; ellipse in this case.
(if (<= (* diffparm diffparm) 1.0e-12)
      (setq endparm (+ stparm (* 2 pi)))
)
(if (<= endparm stparm)
      (setq endparm (+ endparm (* 2 pi)))
)
(setq elist (subst (cons 42 endparm) (assoc 42 elist) elist ))
;; Calculate the Major Axis Vector by first calculating
;; a unit vector using the old Major Radius value. Then
;; Multiplying that by the (possibly) new Major Radius
;; value to get the new Major Axis Vector value.
(setq unitxx (/ xx old_majrad))
(setq unityy (/ yy old_majrad))
(setq unitzz (/ zz old_majrad))
(setq newvecxx (* unitxx majrad))
(setq newvecyy (* unityy majrad))
(setq newveczz (* unitzz majrad))
(setq newmajaxis (list newvecxx newvecyy newveczz))
;; Update Major Axis Vector value
(setq elist (subst (cons 11 newmajaxis) (assoc 11 elist) elist ))
;; Update Radius Ratio value
(setq elist (subst (cons 40 rrat) (assoc 40 elist) elist ))
(entmod elist)
  )

  (defun ddellipse ()
(if (not (new_dialog "ddellipse" dcl_id)) (exit))
;; Set initial tile values
(set_tile_props)
(set_tile_handle)
(set_tile_pt1 1)
(ell_calc)
;; Define action for tiles
(set_action_tiles)
(setq dialog-state (start_dialog))
(if (= dialog-state 0)
   (reset)
)
(if (= dialog-state 1)
   (modify_ellipse)
)
(if (= dialog-state 3)
   (progn
      (modify_ellipse)
      (setq pt1 (getpoint (list x1 y1 z1)  "\nCenter point: "))
      (ver_pt1 1)
      (ddellipse)
   )
)
  )
  ;;
  ;; Modify REGION
  ;;
  (defun modify_region ()
(modify_prop_geom)
(entmod elist)
  )

  (defun ddregion ()
(if (not (new_dialog "ddregion" dcl_id)) (exit))
;; Set initial tile values
(set_tile_props)
(set_tile_handle)
;; Define action for tiles
(set_action_tiles)
(setq dialog-state (start_dialog))
(if (= dialog-state 0)
   (reset)
)
(if (= dialog-state 1)
   (modify_region)
)
  )
  ;;
  ;; Modify 3DSOLID
  ;;
  (defun modify_3dsolid ()
(modify_prop_geom)
(entmod elist)
  )

  (defun dd3dsolid ()
(if (not (new_dialog "dd3dsolid" dcl_id)) (exit))
;; Set initial tile values
(set_tile_props)
(set_tile_handle)
;; Define action for tiles
(set_action_tiles)
(setq dialog-state (start_dialog))
(if (= dialog-state 0)
   (reset)
)
(if (= dialog-state 1)
   (modify_3dsolid)
)
  )
  ;;
  ;; Modify AcDbHatch
  ;;
  (defun modify_hatch ()
(modify_prop_geom)
(entmod elist)
  )

  (defun ddnewhatch ()
(if (equal hatch-elist nil)
      (setq hatch-elist old-elist)
)

(if (not (new_dialog "ddnewhatch" dcl_id)) (exit))

;; disable the thickness tile
(mode_tile "eb_thickness" 1)
(mode_tile "e_thickness" 1)

(setq help_entry "modify_associative_hatch_dialog")
(set_tile_props)
(set_tile_handle)

;; Define action for tiles
(set_action_tiles)
(action_tile "b_hatch" "(done_dialog 2)")
(setq dialog-state (start_dialog))
(cond
   (  (eq dialog-state 0)
      (setq old-elist hatch-elist)
      (setq hatch-elist nil)
      (if (= (checkforlockedlayer ename) nil)
         (reset)
         (progn       ;;; special handling for locked layer reset
            ;; unlock the layer
            (setq layername (cdr (assoc 8 (cdr (entget ename)))))
            (command "_.-LAYER" "_Unlock" layername "")
            ;; reset modifiction
            (reset)
            ;; lock the layer again
            (command "_.-LAYER" "_Lock" layername "")
         )
      )
      nil    ;;; makes (ddnewhatch) return nil for Cancel
   )
   (  (eq dialog-state 1)
      (setq hatch-elist nil)
      (modify_hatch)
      T       ;;; makes (ddnewhatch) return T for Ok
   )
   (  (eq dialog-state 2)

      (if (= (cdr (assoc 70 (tblsearch "LAYER" elayer)))
               4
            )
            ;;; new selected layer is on a locked layer
            ;;; we can simply modify the hatch properties
            (modify_hatch)
            (progn
                  (if (= (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (cdr elist))))))
                        4
                     )
                     ;;; We changed the layer previously and now the hatch lies on a locked layer.
                     ;;; We have to unlock the layer forethat we can update the hatch properties.
                     ;;; If we don't do that (entmod) fails to update to the new layer.
                     (progn
                        (setq layername (cdr (assoc 8 (cdr elist))))
                        (command "_.-LAYER" "_Unlock" layername "")    ;;; unlock the layer
                        (modify_hatch)                               ;;; update the properties
                        (command "_.-LAYER" "_Lock" layername "")    ;;; lock the layer again
                     )
                     ;;;  All other cases we simply update the properties
                     (modify_hatch)
                  )
            )
      )
      (if (= (checkforlockedlayer ename) nil)
            (command "_hatchedit" ename)
            (alert ;|MSG111|;"The hatch object is on a locked layer.")
      )
      (ddmodify ename)
   )
)
  )
  ;;
  ;; Modify BODY
  ;;
  (defun modify_body ()
(modify_prop_geom)
(entmod elist)
  )

  (defun ddbody ()
(if (not (new_dialog "ddbody" dcl_id)) (exit))
;; Set initial tile values
(set_tile_props)
(set_tile_handle)
;; Define action for tiles
(set_action_tiles)
(setq dialog-state (start_dialog))
(if (= dialog-state 0)
   (reset)
)
(if (= dialog-state 1)
   (modify_body)
)
  )
  ;;
  ;; Modify CIRCLE
  ;;
  (defun modify_circle ()
(modify_properties)
(setq pt1 (list x1 y1 z1))
(tempmod pt1 10 1)
(tempmod radius 40 nil)
(entmod elist)
  )

  (defun ddcircle ()
(if (not (new_dialog "ddcircle" dcl_id)) (exit))
;; Set initial tile values
(set_tile_props)
(set_tile_handle)
(set_tile_pt1 1)
(set_tile_rad)
(cir_calc)
;; Define action for tiles
(set_action_tiles)
(set_tile_pt1 1)
(setq dialog-state (start_dialog))
(if (= dialog-state 0)
   (reset)
)
(if (= dialog-state 1)
   (modify_circle)
)
(if (= dialog-state 3)
   (progn
      (modify_circle)
      (setq pt1 (getpoint (list x1 y1 z1)  "\nCenter point: "))
      (ver_pt1 1)
      (ddcircle)
   )
)
  )
  ;;
  ;; Modify ARC
  ;;
  (defun modify_arc ()
(modify_properties)
(setq pt1 (list x1 y1 z1))
(tempmod pt1 10 1)
(tempmod radius 40 nil)
(tempmod st_ang 50 nil)
(tempmod end_ang 51 nil)
(entmod elist)
  )
  (defun ddarc ()
(if (not (new_dialog "ddarc" dcl_id)) (exit))
;; Set initial tile values
(set_tile_props)
(set_tile_handle)
(set_tile_pt1 1)
(set_tile_rad)
(set_tile_stang)
(set_tile_endang)
(arc_calc)
;; Define action for tiles
(set_action_tiles)
(setq dialog-state (start_dialog))
(if (= dialog-state 0)
   (reset)
)
(if (= dialog-state 1)
   (modify_arc)
)
(if (= dialog-state 3)
   (progn
      (modify_arc)
      (setq pt1 (getpoint (list x1 y1 z1) "\nCenter point: "))
      (ver_pt1 1)
      (ddarc)
   )
)
  )
  ;;
  ;; Modify SOLID or TRACE
  ;; Note the Z value of the object is determined by the Z value of the fourth
  ;; point - code 13.  Changing the point values of a solid or trace from a UCS
  ;; that is nonplanar to the UCS the object was created may confuse the user.
  (defun modify_solid ()
(modify_properties)
(setq pt1 (list x1 y1 z4))
(setq pt2 (list x2 y2 z4))
(setq pt3 (list x3 y3 z4))
(setq pt4 (list x4 y4 z4))
(tempmod pt1 10 1)
(tempmod pt2 11 1)
(tempmod pt3 12 1)
(tempmod pt4 13 1)
(entmod elist)
  )

  (defun ddsolid ()
(if (= etype "SOLID")
      (if (not (new_dialog "ddsolid" dcl_id)) (exit))
      (if (not (new_dialog "ddtrace" dcl_id)) (exit))
)
;; Set initial tile values
(set_tile_props)
(set_tile_handle)
(set_tile_pt1 1)
(set_tile_pt2 1)
(set_tile_pt3 1)
(set_tile_pt4 1)
;; Define action for tiles
(set_action_tiles)
(setq dialog-state (start_dialog))
(if (= dialog-state 0)
   (reset)
)
(if (= dialog-state 1)
   (modify_solid)
)
(if (= dialog-state 3)
   (progn
      (modify_solid)
      (setq pt1 (getpoint (list x1 y1 z1) "\nFirst point: "))
      (ver_pt1 1)
      (ddsolid)
   )
)
(if (= dialog-state 4)
   (progn
      (modify_solid)
      (entmod elist)
      (setq pt2 (getpoint (list x2 y2 z2) "\nSecond point: "))
      (ver_pt2 1)
      (ddsolid)
   )
)
(if (= dialog-state 5)
   (progn
      (modify_solid)
      (setq pt3 (getpoint (list x3 y3 z3) "\nThird point: "))
      (ver_pt3 1)
      (ddsolid)
   )
)
(if (= dialog-state 6)
   (progn
      (modify_solid)
      (setq pt4 (getpoint (list x4 y4 z4) "\nFourth point: "))
      (ver_pt4 1)
      (ddsolid)
   )
)
  )
  ;;
  ;; Modify 3DFACE
  ;;
  ;; Check visibility of edges
  ;;
  (defun edgetest (/ bit1 bit2 bit3 bit4)
(if (= edge1 "1") (setq bit1 0) (setq bit1 1))
(if (= edge2 "1") (setq bit2 0) (setq bit2 2))
(if (= edge3 "1") (setq bit3 0) (setq bit3 4))
(if (= edge4 "1") (setq bit4 0) (setq bit4 8))
(+ bit1 bit2 bit3 bit4)
  )

  (defun modify_3dface ()
(modify_properties)
(setq pt1 (list x1 y1 z1))
(setq pt2 (list x2 y2 z2))
(setq pt3 (list x3 y3 z3))
(setq pt4 (list x4 y4 z4))
(tempmod pt1 10 0)
(tempmod pt2 11 0)
(tempmod pt3 12 0)
(tempmod pt4 13 0)
(tempmod (edgetest) 70 nil)
(entmod elist)
  )

  (defun dd3dface ()
(if (not (new_dialog "dd3dface" dcl_id)) (exit))
(set_tile_props)
(set_tile_handle)
(set_tile_pt1 0)
(set_tile_pt2 0)
(set_tile_pt3 0)
(set_tile_pt4 0)
(set_tile_edges)
;; Define action for tiles
(set_action_tiles)
(setq dialog-state (start_dialog))
(if (= dialog-state 0)
   (reset)
)
(if (= dialog-state 1)
   (modify_3dface)
)
(if (= dialog-state 3)
   (progn
      (modify_3dface)
      (setq pt1 (getpoint (list x1 y1 z1) "\nFirst pt: "))
      (ver_pt1 0)
      (dd3dface)
   )
)
(if (= dialog-state 4)
   (progn
      (modify_3dface)
      (setq pt2 (getpoint (list x2 y2 z2) "\nSecond point: "))
      (ver_pt2 0)
      (dd3dface)
   )
)
(if (= dialog-state 5)
   (progn
      (modify_3dface)
      (setq pt3 (getpoint (list x3 y3 z3) "\nThird point: "))
      (ver_pt3 0)
      (dd3dface)
   )
)
(if (= dialog-state 6)
   (progn
      (modify_3dface)
      (setq pt4 (getpoint (list x4 y4 z4) "\nFourth point: "))
      (ver_pt4 0)
      (dd3dface)
   )
)
  )

  ;;
  ;; Image functions
  ;;
  (defun image_scale (/ upixel en n userscale temp)
;; Calculate the size of an image pixel in AutoCAD units
(setq upixel (distance '(0 0 0) (cdr (assoc 11 elist))))

;; Retrieve the user scale
(setq en (dictsearch (namedobjdict) "ACAD_IMAGE_VARS"))

;; Next, extract the image units and pixel resolution
(if (or (= 0 (cdr (assoc 281 image:olist))) (= 0 (cdr (assoc 72 en))))
   (setq image:scale (* (cadr (assoc 13 elist)) upixel))
   (progn
      ;; Convert the user scale to the proper word
      (setq n (cdr (assoc 72 en)))
      (setq temp (getvar "LUNITS"))
      (if (and (/= n 0) (or (= temp 3) (= temp 4))) (setq n 5))
      (if (= n 1) (setq userscale "Millimeter"))
      (if (= n 2) (setq userscale "Centimeter"))
      (if (= n 3) (setq userscale "Meter"))
      (if (= n 4) (setq userscale "Kilometer"))
      (if (= n 5) (setq userscale "Inch"))
      (if (= n 6) (setq userscale "Foot"))
      (if (= n 7) (setq userscale "Yard"))
      (if (= n 8) (setq userscale "Mile"))
      (setq image:scale (/ upixel (cvunit 1 "Millimeter" userscale) (cadr (assoc 11 image:olist))))
   )
)
  )

  ;;
  ;; Scale factors for block insertions
  ;;
  (defun image_set_tile_scale (/ temp)
(setq temp (getvar "LUNITS"))
(setvar "LUNITS" 2)
(set_tile "xscale" (ai_rtos (* image:scale image:mult)))
(set_tile "wid" (ai_rtos (* image:width image:mult)))
(set_tile "hght" (ai_rtos (* image:height image:mult)))
(setvar "LUNITS" temp)
  )

  ;;
  ;; Set the scale, width and height values appropriately.
  ;;
  (defun image_update (field value / orig_value new_value mult)
(if (= field "xscale")
      (setq orig_value image:scale)
)
(if (= field "wid")
      (setq orig_value image:width)
)
(if (= field "hght")
      (setq orig_value image:height)
)
(setq new_value (verify_d field value (* image:mult orig_value)))
(if (/= new_value old_value)
   ;; Make sure the user has entered a sufficiently large value
   (if new_value
      (progn
      (if (< new_value 1e-8)
         (setq mult image:mult)
         (setq mult (/ new_value orig_value))
      )
      (setq image:mult mult)
      (image_set_tile_scale)
      )
   )
)
  )

  (defun image_disp_opt (bit)
(setq image:options (Boole 6 image:options bit))
  )

  (defun image_modify ()
(modify_properties)
(setq pt1 (list x1 y1 z1))
(tempmod pt1 10 0)
(entmod elist)
  )

  (defun image_clean_variables ()
;; Clean up global variables used here
(setq image:scale nil)
(setq image:angle nil)
(setq image:width nil)
(setq image:height nil)
(setq image:options nil)
(setq image:oname nil)
(setq image:olist nil)
(setq image:mult nil)
(setq st_ang nil)
  )

  (defun image_scale_vector (v1 value)
(list (* (car v1) value) (* (cadr v1) value) (* (last v1) value))
  )

  (defun image_cross_product (v1 v2 / vx vy vz)
(setq vx (- (* (cadr v1) (last v2)) (* (cadr v2) (last v1))))
(setq vy (- (* (car v2) (last v1)) (* (car v1) (last v2))))
(setq vz (- (* (car v1) (cadr v2)) (* (car v2) (cadr v1))))
(list vx vy vz)
  )

  (defun image_dot_product (v1 v2)
(+ (* (car v1) (car v2)) (* (cadr v1) (cadr v2)) (* (last v1) (last v2)))
  )

  (defun image_add_vector (v1 v2)
(list (+ (car v1) (car v2)) (+ (cadr v1) (cadr v2)) (+ (last v1) (last v2)))
  )

  (defun image_subtract_vector (v1 v2)
(list (- (car v1) (car v2)) (- (cadr v1) (cadr v2)) (- (last v1) (last v2)))
  )

  (defun image_normalize_vector (v1)
(image_scale_vector v1 (/ 1. (sqrt (image_dot_product v1 v1))))
  )

  (defun image_rotate_vector (vector angle axis / along_axis axis_x_in_rot_plane axis_y_in_rot_plane in_rot_plane)
;; Normalize the axis
(setq axis (image_normalize_vector axis))
(setq along_axis (image_scale_vector axis (image_dot_product vector axis)))
(setq axis_x_in_rot_plane (image_subtract_vector vector along_axis))
(setq axis_y_in_rot_plane (image_cross_product axis axis_x_in_rot_plane))
(setq in_rot_plane
   (image_add_vector
      (image_scale_vector axis_x_in_rot_plane (cos angle))
      (image_scale_vector axis_y_in_rot_plane (sin angle))
   )
)
(image_add_vector along_axis in_rot_plane)
  )

  ;;
  ;; Calculate current rotation angle if appropriate.
  ;; If not, grey out the rotation field.
  ;;
  (defun image_rotation (/ normal rlength zlength sqrt_tolerance)
;; Determine if image normal is codirectional with
;; the current UCS Z-vector.
;;
(setq normal (trans (image_normalize_vector (image_cross_product (cdr (assoc 11 elist)) (cdr (assoc 12 elist)))) 0 1 1))
(setq rlength (+ (* (car normal) (car normal)) (* (cadr normal) (cadr normal))))
(setq zlength (* (last normal) (last normal)))
;; Note that the value .0001 in the radians is approximately 0.0057 degrees.
;;
;;             cos(.0001)^2
;; Tolerance = --------------
;;             sin(.0001)^2
;;
(setq sqrt_tolerance (/ (cos 0.0001) (sin 0.0001)))
(if (and (< (* rlength sqrt_tolerance sqrt_tolerance) zlength) (> (last normal) 0))
   (setq image:angle (angle '(0 0 0) (trans (cdr (assoc 11 elist)) 0 1 1)))
   (progn
      (mode_tile "st_ang" 1)
      (setq image:angle 0)
   )
)
  )

  ;;
  ;; Modify Image
  ;;
  (defun modify_image (/ u_vector v_vector z_vector)
(modify_properties)
(setq pt1 (list x1 y1 z1))
(tempmod pt1 10 0)
;; Make display option changes to image
(emod image:options 70)
;; Get the u and v vectors
(setq u_vector (cdr (assoc 11 elist)))
(setq v_vector (cdr (assoc 12 elist)))

;; Make scale changes to the vectors
(if (/= image:mult 1)
   (progn
      (setq u_vector (image_scale_vector u_vector image:mult))
      (setq v_vector (image_scale_vector v_vector image:mult))
   )
)
;; Rotate the vectors
(setq st_ang (- st_ang image:angle))
(if (/= st_ang 0)
   (progn
      (setq z_vector
      (image_cross_product
         (image_normalize_vector u_vector)
         (image_normalize_vector v_vector)
      )
      )
      (setq u_vector (image_rotate_vector u_vector st_ang z_vector))
      (setq v_vector (image_rotate_vector v_vector st_ang z_vector))
   )
)
(emod u_vector 11)
(emod v_vector 12)
(entmod elist)
  )

  ;;
  ;; Run imageadjust on given entity, working around possible
  ;; re-entrancy problems
  ;;
  (defun image_adjust (ename)
(verify_arxapp_loaded "ism.arx") ;; make sure it's loaded...
(imageadjust ename)
  )

  (defun ddimage ()
(if (not (new_dialog "ddimage" dcl_id)) (exit))

;; Grey out the thickness field.
(mode_tile "b_thickness" 1)
(mode_tile "eb_thickness" 1)

;; Get the associated def object.
(setq image:oname (cdr (assoc 340 elist)))
(setq image:olist (entget image:oname))

;; Set initial tile values
(set_tile_props)
(set_tile_handle)
(set_tile_pt1 0)
(setq image:scale (image_scale))
(setq st_ang (image_rotation))
(setq image:width (* (distance '(0 0 0) (cdr (assoc 11 elist))) (cadr (assoc 13 elist))))
(setq image:height (* (distance '(0 0 0) (cdr (assoc 12 elist))) (caddr (assoc 13 elist))))
(setq image:options (cdr (assoc 70 elist)))

;; Record the last multiplier for use in image_update function
(setq image:mult 1)

;; Retrieve the image name
(setq fn (reverse (dictsearch (namedobjdict) "ACAD_IMAGE_DICT")))
(setq flag 0)
(foreach n fn
   (if (= flag 1)
      (progn
      ;; Display the image name
      (set_tile "image_name" (cdr n))
      (setq flag 2)
      )
   )
   (if (= flag 0)
      (if (equal (cdr n) image:oname) (setq flag 1))
   )
)

(set_tile "image_path" (cdr (assoc 1 image:olist)))
(set_tile "st_ang" (ai_angtos image:angle))
(image_set_tile_scale)

;; Check the appropriate boxes
(if (/= (Boole 1 image:options 1) 0) (set_tile "image_show" "1"))
(if (/= (Boole 1 image:options 2) 0) (set_tile "image_non_ortho" "1"))
(if (/= (Boole 1 image:options 4) 0) (set_tile "image_clipped" "1"))
(if (/= (Boole 1 image:options 8) 0) (set_tile "image_transparency" "1"))

;; Define action for tiles
(set_action_tiles)
(action_tile "xscale" "(image_update \"xscale\" $value)")
(action_tile "st_ang" "(ver_ang1 $value)")
(action_tile "wid" "(image_update \"wid\" $value)")
(action_tile "hght" "(image_update \"hght\" $value)")
(action_tile "image_show" "(image_disp_opt 1)")
(action_tile "image_non_ortho" "(image_disp_opt 2)")
(action_tile "image_clipped" "(image_disp_opt 4)")
(action_tile "image_transparency" "(image_disp_opt 8)")
(action_tile "image_adjust" "(done_dialog 4)")

(setq dialog-state (start_dialog))
(if (= dialog-state 0)
   (progn
      (reset)
      (image_clean_variables)
   )
)
(if (= dialog-state 1)
   (progn
      (modify_image)
      (image_clean_variables)
   )
)
(if (= dialog-state 3)
   (progn
      (modify_image)
      (image_clean_variables)
      (setq pt1 (getpoint (list x1 y1 z1) "\nNew Insertion Point: "))
      (ver_pt1 0)
      (ddimage)
   )
)
(if (= dialog-state 4)
   (progn
      (modify_image)
      (image_adjust ename)
      (setq elist (entget ename))
      (ddimage)
   )
)
  )

  ;;
  ;; Modify BLOCK (and its Attributes, if any)
  ;;
  (defun modify_block ( / el en2 p1 p2 oldp1 oldp2 new_hgt old_hgt attr
                        new_wid old_wid old_rot scaling old_scale
                        xdelta ydelta zdelta xbase ybase zbase ipos)
(modify_properties)

;; First, translate and scale the Attributes, if there are any.
(setq old_rot (cdr (assoc 50 elist))
      old_scale (list (cdr (assoc 41 elist))
                        (cdr (assoc 42 elist))
                        (cdr (assoc 43 elist))
                  )
      scaling (or (/= xscale (car old_scale))
                     (/= yscale (cadr  old_scale))
                     (/= zscale (caddr old_scale))
                  )
      attr    nil             ; No Attributes modified yet
)
(if scaling
   (progn
      (setq xdelta (/ xscale (car old_scale))
            ydelta (/ yscale (cadr  old_scale))
            zdelta (/ zscale (caddr old_scale))
            ipos (cdr (assoc 10 elist))
            xbase  (car ipos)
            ybase  (cadr  ipos)
            zbase  (caddr ipos)
            en2 (entnext ename)  ; First Attribute
      )

      ; If the Block is rotated, temporarily un-rotate it, along
      ; with all its Attributes, so the scaling/translation of the
      ; Attributes won't have to take the Block rotation into account.
      (if (/= old_rot 0.0)
      (progn
         (command "_rotate" ename "" pt1 (ai_angtos (- old_rot)))
         (setq old_rot 0.0
               elist (subst (cons 50 0.0) (assoc 50 elist) elist)
         )
      )
      )

      (while en2
      (setq el (entget en2))
      (if (= (cdr (assoc 0 el)) "ATTRIB")
         (progn
            (setq old_hgt (cdr (assoc 40 el))  ; Height
                  old_wid (cdr (assoc 41 el))  ; Width-factor
                  oldp1 (cdr (assoc 10 el))  ; Generation start point
                  oldp2 (cdr (assoc 11 el))  ; Optional alignment pt
                  ha (cdr (assoc 72 el))  ; Horizontal alignment
                  va (cdr (assoc 74 el))  ; Vertical alignment

                  ; Translate gen. start point
                  p1 (list (+ xbase (* xdelta (- (car oldp1) xbase)))
                              (+ ybase (* ydelta (- (cadr  oldp1) ybase)))
                              (+ zbase (* zdelta (- (caddr oldp1) zbase)))
                        )
                  el (subst (cons 10 p1) (assoc 10 el) el)
            )

            ; Translate alignment pt similarly, if present and applicable
            (if (and oldp2 (or (/= ha 0)
                              (/= va 0)
                           )
               )
            (setq p2 (list (+ xbase (* xdelta (- (car oldp2) xbase)))
                           (+ ybase (* ydelta (- (cadr  oldp2) ybase)))
                           (+ zbase (* zdelta (- (caddr oldp2) zbase)))
                     )
                  el (subst (cons 11 p2) (assoc 11 el) el)
            )
            )

            ; Each Attribute's height and width-factor were computed
            ; based on the Block's scale factors.  Adjust them now,
            ; by first reducing to values for 1x1 scale...
            (setq new_hgt (/ old_hgt (cadr old_scale))
                  new_wid (/ old_wid (/ (car old_scale) (cadr old_scale)))
            )
            ; ...and then rescaling.
            (setq new_hgt (* new_hgt yscale)
                  new_wid (* new_wid (/ xscale yscale))
            )
            (if (/= new_hgt old_hgt)
            (setq el (subst (cons 40 new_hgt) (assoc 40 el) el))
            )
            (if (/= new_wid old_wid)
            (setq el (subst (cons 41 new_wid) (assoc 41 el) el))
            )
            (entmod el)
            (setq attr T          ; At least one Attribute modified
                  en2  (entnext en2) ; Next Attribute
            )
         )
         (setq en2 nil)       ; No more attributes
      )
      )
   )
)

(setq pt1 (list x1 y1 z1))
(tempmod xscale 41 nil)
(tempmod yscale 42 nil)
(tempmod zscale 43 nil)
(tempmod col-sp 44 nil)
(tempmod row-sp 45 nil)
(tempmod columns 70 nil)
(tempmod rows 71 nil)
(if (= xclipmode nil)
   (entmod elist)
   (setq xclipmode nil)
)
(move_pt1 1)

;; Now do the rotation with the ROTATE command.
(if (/= old_rot rot)
   (command "_rotate" ename "" pt1 (ai_angtos (- rot old_rot)))
   (if attr                         ; Else, if attributes were modified,
      (entupd ename)                ; just regen to force attrib display
   )
)
(setq elist (entget ename))
  )
  (defun ddblock (/ temp temp_xclip newhatch blkname blklist blktype program xrefpath)
(setq newhatch 0)
(setq blkname (cdr (assoc 2 elist)))
(setq blklist (tblsearch "block" blkname))
(setq blktype (cdr (assoc 70 blklist)))
(setq xcliponoff 0)
(if (or (= blktype 0)(= blktype 36))
         (progn
            (setq xcliponoff (xclipon elist))
      (setq temp_xclip xcliponoff)
      )
)
(if (= (logand blktype 4) 4)
   (progn
      (setq xrefpath (cdr (assoc 1 blklist)))
      (setq help_entry "modify_External_Reference_dialog")
      (if (not (new_dialog "ddxref" dcl_id)) (exit))
      (set_tile "Bl_name" blkname)
      (set_tile "path" xrefpath)
   )
   (progn
      ;; Get program name for use as Xdata app name
      (if (not (setq program (getvar "program")))
         (setq program "acad")
      )
      (if (and (setq temp (assoc -3 (entget ename (list program))))
               (= (cdr (assoc 1000 (cdadr temp))) "HATCH")
               (assoc 1005 (cdadr temp))
         )
      (progn
            (setq newhatch 1)
            (setq help_entry  "modify_Hatch_dialog")
            ;;; convert the object into a new hatch
            (ai_undo_on) ;; enable undo
            (COMMAND "_.UNDO" "_Mark")
            (COMMAND "_.CONVERT" "_Hatch" "_Select" (cdr (assoc -1 elist)) "")
            ;;; suppress nasty message from convert command
            (princ "\r                                                                   \r")
            (setq elist (entget (setq ename (cdr (assoc -1 elist)))))
            (setq old-elist elist)
            ;;; If we have cancelled ddmodify
            (if (not (ddnewhatch))    ;;; (ddnewhatch) returns nil for Cancel or T for Ok
               (command "_.UNDO" "_Back")
            )
            (ai_undo_off) ;; restore undo state
      )
      (progn
         (if (not (new_dialog "ddblock" dcl_id)) (exit))
         (if ( = "*" (substr blkname 1 1))
            (set_tile "Bl_name" (strcat blkname " - Anonymous block"))
            (set_tile "Bl_name" blkname)
         )
         (setq help_entry  "modify_Block_Insertion_dialog")
      )
      )
   )
)
(if (= newhatch 0)
   (progn
      (set_tile_props)
      (set_tile_handle)
      (set_tile_pt1 1)
      (set_tile_rot)
      (set_tile_scale)
      (set_tile_rc)
      (if (= (logand blktype 1) 1)
      (progn
         (mode_tile "xscale" 1)
         (mode_tile "yscale" 1)
         (mode_tile "zscale" 1)
         (mode_tile "rot" 1)
         (mode_tile "columns" 1)
         (mode_tile "rows" 1)
         (mode_tile "col_sp" 1)
         (mode_tile "row_sp" 1)
      )
      )
      ;; Define action for tiles
      (set_action_tiles)
      (setq dialog-state (start_dialog))
      (cond
         (  (eq dialog-state 0)
            (setq pt1 (trans (cdr (assoc 10 old-elist)) ename 1))
            (move_pt1 1)
            (reset))
         (  (eq dialog-state 1)
            (if (and (/= temp_xclip xcliponoff) (or (= blktype 0)(= blktype 36)))
            (xclip)
            )
            (modify_block))
         (  (eq dialog-state 3)
            (modify_block)
            (setq pt1 (getpoint (list x1 y1 z1)  "\nInsertion point: "))
            (move_pt1 1)
            (ddblock))
         (  (eq dialog-state 4)
            (modify_block)
            ;; Get current handle.
            (setq hand (cdr (assoc 5 elist)))
            (command "_hatchedit" ename)
            ;; If OK in hatchedit, a *new* entity is created and the old one
            ;; is deleted.  So if the old one exists, it must have been a
            ;; so rest the entity.
            (if (entget (handent hand)) (reset))
         )
      )
   )
)
  )
  ;;
  ;; Modify SHAPE
  ;;
  (defun modify_shape ()
(modify_properties)
(setq pt1 (list x1 y1 z1))
(tempmod pt1 10 1)
(tempmod hght 40 nil)
(tempmod wid 41 nil)
(tempmod rot 50 nil)
(tempmod obl 51 nil)
(entmod elist)
  )

  (defun ddshape ()
(if (not (new_dialog "ddshape" dcl_id)) (exit))
(set_tile_props)
(set_tile_handle)
(set_tile_pt1 1)
(set_tile_rot)
(set_tile_hght)
(set_tile_wid)
(set_tile_obl)
(set_tile "sh_name" (cdr (assoc 2 elist)))
;; Define action for tiles
(set_action_tiles)
(setq dialog-state (start_dialog))
(if (= dialog-state 0)
   (reset)
)
(if (= dialog-state 1)
   (modify_shape)
)
(if (= dialog-state 3)
   (progn
      (modify_shape)
      (setq pt1 (getpoint (list x1 y1 z1)  "\nInsertion point: "))
      (ver_pt1 1)
      (ddshape)
   )
)
  )
  ;;
  ;; Modify TEXT or ATTDEF
  ;;
  ;; Set bit code for upside-down and backwards setting
  ;;
  (defun code_71 ()
(cond ((and (= bkwd "0") (= upsd "0")) 0)
      ((and (= bkwd "1") (= upsd "0")) 2)
      ((and (= bkwd "0") (= upsd "1")) 4)
      ((and (= bkwd "1") (= upsd "1")) 6)
)
  )
  ;;
  ;; Style action.  Reset widget values to style defaults
  ;;
  (defun style_act (index / style-list)
(setq style-idx (atoi index))
(setq tstyle (nth style-idx slist))
(setq style-idx (itoa style-idx))
(set_tile "style" style-idx)
(setq style-list (tblsearch "style" tstyle))
(setq shght (cdr (assoc 40 style-list)))
(if (/= shght 0)
   (progn
      (setq hght shght)
      (set_tile "hght" (ai_rtos hght))
   )
)
(setq wid (cdr (assoc 41 style-list)))
(set_tile "wid" (ai_rtos wid))
(setq obl (cdr (assoc 50 style-list)))
(set_tile "obl" (ai_angtos obl))
(setq bk-up (cdr (assoc 71 style-list)))
(if (= (logand bk-up 2) 2)
   (set_tile "bkwd" (itoa (setq bkwd 1)))
   (set_tile "bkwd" (itoa (setq bkwd 0)))
)
(if (= (logand bk-up 4) 4)
   (set_tile "upsd" (itoa (setq upsd 1)))
   (set_tile "upsd" (itoa (setq upsd 0)))
)
  )
  ;;
  ;; Justification action.  Set vertical and horizontal alignment variables,
  ;; grey out rotation and height if alignment = "aligned", grey out rotation
  ;; if alignment = "fit".
  ;;
  (defun jlist_act (index / templist)
(setq just-idx (atoi index))
(cond
   ((= just-idx 0) (setq va 0 ha 0))
   ((= just-idx 1) (setq va 0 ha 1))
   ((= just-idx 2) (setq va 0 ha 2))
   ((= just-idx 3) (setq va 0 ha 3))
   ((= just-idx 4) (setq va 0 ha 4))
   ((= just-idx 5) (setq va 0 ha 5))
   ((= just-idx 6) (setq va 3 ha 0))
   ((= just-idx 7) (setq va 3 ha 1))
   ((= just-idx 8) (setq va 3 ha 2))
   ((= just-idx 9) (setq va 2 ha 0))
   ((= just-idx 10) (setq va 2 ha 1))
   ((= just-idx 11) (setq va 2 ha 2))
   ((= just-idx 12) (setq va 1 ha 0))
   ((= just-idx 13) (setq va 1 ha 1))
   ((= just-idx 14) (setq va 1 ha 2))
)
(if (or (= ha 3) (= ha 5))  ; If Aligned or Fit text
   (mode_tile "rot" 1)
   (mode_tile "rot" 0)
)
(if (= ha 3)             ; If Aligned text
   (mode_tile "hght" 1)
   (mode_tile "hght" 0)
)
(if (= ha 5)             ; If Fit text
   (mode_tile "wid" 1)
   (mode_tile "wid" 0)
)
;; Reset rotation and height if changing from aligned.
(if (and (= ha-prev 3)  (/= ha 3))
   (progn
      (set_tile "rot"  (ai_angtos (setq rot 0.0)))
      (set_tile "hght" (ai_rtos (setq hght 1.0)))
   )
)

;; Reset rotation and width if changing from fit.
(if (and (= ha-prev 5) (/= ha 5))
   (progn
      (set_tile "rot" (ai_angtos (setq rot 0.0)))
      (set_tile "wid" (ai_rtos (setq wid 1.0)))
   )
)

(setq ha-prev ha)          ; update ha-prev for next time
(setq just-idx (itoa just-idx))
  )
  ;;
  ;; Set intitial alignment setting based on vertical and horizontal alignment
  ;; bit codes.
  ;;
  (defun set_just_idx ()
(cond
   ((= ha 0)          ; Horiz alignment = Left
      (cond
      ((= va 0) (setq just-idx "0"))
      ((= va 1) (setq just-idx "12"))
      ((= va 2) (setq just-idx "9"))
      ((= va 3) (setq just-idx "6"))
      )
   )
   ((= ha 1)          ; Horiz alignment = Center
      (cond
      ((= va 0) (setq just-idx "1"))
      ((= va 1) (setq just-idx "13"))
      ((= va 2) (setq just-idx "10"))
      ((= va 3) (setq just-idx "7"))
      )
   )
   ((= ha 2)          ; Horiz alignment = Right
      (cond
      ((= va 0) (setq just-idx "2"))
      ((= va 1) (setq just-idx "14"))
      ((= va 2) (setq just-idx "11"))
      ((= va 3) (setq just-idx "8"))
      )
   )
   ((= ha 3) (setq just-idx "3")) ; Aligned
   ((= ha 4) (setq just-idx "4")) ; Middle
   ((= ha 5) (setq just-idx "5")) ; Fit
   (T (setq just-idx "0"))
)
just-idx
  )

  (defun modify_text ()
;;  insertion point
(setq showpt (list x1 y1 z1))
(setq bit-10 (trans showpt 1 ename))
;;  alignment point
;;  for 'Aligned' or 'Fit', alignment point must be different
;;  for all others, use insertion point
;;  (ACAD will recompute insertion point)
(if (or (= ha 3) (= ha 5))
   (progn
      ;;  if no alignment point, fabricate one
      (if (not alipt)
      ;;  add text width to insertion point
      (setq alipt
         (list (+ (car showpt) (car (cadr (textbox elist))))
               (cadr showpt)
               (caddr showpt)
         )
      )
      )
      (setq bit-11 (trans alipt 1 ename))
   )
   (setq bit-11 bit-10)
)
(modify_properties)
(tempmod tstyle 7 nil)
(tempmod bit-10 10 nil)
(tempmod bit-11 11 nil)
(tempmod text 1 nil)
(tempmod hght 40 nil)
(tempmod wid 41 nil)
(tempmod rot 50 nil)
(tempmod obl 51 nil)
(setq bk-up (+ (* bkwd 2) (* upsd 4)))
(tempmod bk-up 71 nil)
(tempmod ha 72 nil)
;; Attdefs use 74, text 73
(if (= etype "ATTDEF")
   (progn
      (tempmod attag 2 nil)
      (tempmod atprompt 3 nil)
      (setq icvp (+ inv (* 2 con) (* 4 vfy) (* 8 pre)))
      (tempmod icvp 70 nil)
      (tempmod va 74 nil)
   )
   (tempmod va 73 nil)
)
(entmod elist)
  )

  (defun ddtext (/ 2ndpt slist i)
(if (= etype "TEXT")
   (if (not (new_dialog "ddtext" dcl_id)) (exit))
   (if (not (new_dialog "ddattdef" dcl_id)) (exit))
)
(set_tile_props)
(set_tile_handle)
(set_tile_text)
(set_tile_tag)
(set_tile_prompt)
(set_tile_hght)
(set_tile_wid)
(set_tile_rot)
(set_tile_obl)
(set_tile_bk-up)
(set_tile_icvp)
(set_tile_style)
(set_tile_just)
(setq pt1 (trans (cdr (assoc 10 elist)) ename 1))
(if (not (assoc 11 elist))
   (progn (setq pt2 pt1)
      (setq elist (cons (cons '11 (cdr (assoc 10 elist))) elist ))
   )
;;(trans '(0.0 0.0 0.0) ename 1))
   (setq pt2 (trans (cdr (assoc 11 elist)) ename 1))
)
(if (or (and (= ha 0) (= va 0))
         (= ha 3)
         (= ha 5)
      )
   (setq showpt pt1)
   (setq showpt pt2)
)
(if (or (= ha 3) (= ha 5))
   (setq alipt pt2)
   (setq alipt nil)
)

(set_tile "x1_pt" (ai_rtos (setq x1 (car showpt))))
(set_tile "y1_pt" (ai_rtos (setq y1 (cadr showpt))))
(set_tile "z1_pt" (ai_rtos (setq z1 (caddr showpt))))

;; Define action for tiles
(set_action_tiles)
;; Set focus initially to the text edit box.
(if (not i) (progn (mode_tile "t_string" 2)(setq i 1)))
(setq dialog-state (start_dialog))
(if (= dialog-state 0)
   (reset)
)
(if (= dialog-state 1)
   (modify_text)
)
(if (= dialog-state 3)
   (progn
      (modify_text)
      (if (or (= ha 3) (= ha 5))
      (progn
         (setq showpt (getpoint (list x1 y1 z1) "\nFirst point: "))
         (if (not showpt)
            (setq showpt (list x1 y1 z1))
         )
         (setq 2ndpt (getpoint showpt "\nSecond point: "))
         (if 2ndpt
            (progn
            (setq alipt 2ndpt)
            (tempmod showpt 10 1)
            (tempmod alipt 11 1)
            (entmod elist)
            )
         )
         (setq elist (entget ename))
      )
      (progn
         (setq showpt (getpoint (list x1 y1 z1) "\nInsertion point: "))
         (if showpt
            (progn
            (if (and (= ha 0) (= va 0))
               (tempmod showpt 10 1)
               (tempmod showpt 11 1)
            )
            (entmod elist)
            )
            (setq showpt (list x1 y1 z1))
         )
      )
      )
      (ddtext)
   )
)
  )

  ;;
  ;; Modify MTEXT
  ;;
  (defun modify_mtext ()
(modify_properties)
(setq pt1 (list x1 y1 z1))
(tempmod pt1 10 0)
(tempmod text 1 nil)
(tempmod tstyle 7 nil)
(tempmod just-idx 71 nil)
(cond
   ((= dir-idx 0) (setq dir-idx 1))
   ((= dir-idx 1) (setq dir-idx 3))
   ((= dir-idx 2) (setq dir-idx 5))
   (T (setq dir-idx 1))
)
(tempmod dir-idx 72 nil)
(tempmod hght 40 nil)
(tempmod wid 41 nil)
(tempmod rot 50 nil)
(entmod elist)
  )

  ;; Set MText text style
  (defun MText_style (index / style-list)
(setq style-idx (atoi index))
(setq tstyle (nth style-idx slist))
(setq style-idx (itoa style-idx))
(set_tile "style" style-idx)
(setq style-list (tblsearch "style" tstyle))
(setq shght (cdr (assoc 40 style-list)))
(if (/= shght 0)
   (progn
      (setq hght shght)
      (set_tile "hght" (ai_rtos hght))
   )
)
  )

  ;; Run DDEDIT on given entity, working around possible re-entrancy
  ;; problems with MTEXTED
  (defun safe_ddedit (ename / orgMTextEd work)
(setq orgMTextEd (getvar "MTEXTED"))
(setq work orgMTextEd)
(if (= ":" (substr work 1 1))
   (progn
      (while (and (< 0 (strlen work)) (/= "#" (substr work 1 1)))
      (setq work (substr work 2))
      )
      (if (= "#" (substr work 1 1))
      (setq work (substr work 2))
      )
      (setvar "MTEXTED" work)
   )
)
(verify_arxapp_loaded "acmted.arx") ;; make sure it's loaded...
(command "_DDEDIT" ename "")
(setvar "MTEXTED" orgMTextEd)
  )

  ;; Verify MText object width
  (defun ver_MtextWidth (value)
(setq value (distof value))
(set_tile "MTextWidth" (ai_rtos value))
(set_tile "error" "")
(if (< value 0.0)
   (set_tile "error" "Value must be zero or positive.")
   (setq wid value)
)
  )

  (defun ddmtext ( / gc3)
;; Get dialog
(if (not (new_dialog "ddmtext" dcl_id)) (exit))

;; Load list boxes
(start_list "MTextJustify")
(mapcar 'add_list '(
                     "Top Left"
                     "Top Center"
                     "Top Right"
                     "Middle Left"
                     "Middle Center"
                     "Middle Right"
                     "Bottom Left"
                     "Bottom Center"
                     "Bottom Right"
                     )
)
(end_list)

(start_list "MTextDirection")
(mapcar 'add_list '(
                     "Horizontal"
                     "Vertical"
                     "By Style"
                     )
)
(end_list)

;; Set initial tile values
(set_tile_props)
(set_tile_handle)
(set_tile_pt1 0)
(set_tile_style)
(setq just-idx (cdr (assoc 71 elist)))
(set_tile "MTextJustify" (itoa (1- just-idx)))
(setq dir-idx (cdr (assoc 72 elist)))
(cond
   ((= dir-idx 1) (setq dir-idx 0))
   ((= dir-idx 2) (setq dir-idx 0))
   ((= dir-idx 3) (setq dir-idx 1))
   ((= dir-idx 4) (setq dir-idx 1))
   ((= dir-idx 5) (setq dir-idx 2))
   (T (setq dir-idx 0))
)
(set_tile "MTextDirection" (itoa dir-idx))
(set_tile "MTextWidth" (ai_rtos (setq wid (cdr (assoc 41 elist)))))
(set_tile_hght)
(set_tile_rot)

;; Set edit box, disable if too long
(setq gc3 (cdr (assoc 3 elist))
      text (cdr (assoc 1 elist)))
(if gc3
   (progn  ;; Text is over 250 chars, disable edit tile
      (set_tile "t_string" (strcat (substr gc3 1 25) " ..."))
      (mode_tile "t_string" 1)
   )
   (if (> (strlen text) 80)
      (progn  ;; Still too big
      (set_tile "t_string" (strcat (substr text 1 25) " ..."))
      (mode_tile "t_string" 1)
      )
      (set_tile "t_string" text)
   )
)

;; Define action for tiles
(set_action_tiles)
(action_tile "style" "(MText_style $value)")
(action_tile "MTextWidth" "(ver_MtextWidth $value)")
(action_tile "MTextEdit" "(done_dialog 4)")
(action_tile "MTextJustify" "(setq just-idx (1+ (atoi $value)))")
(action_tile "MTextDirection" "(setq dir-idx (atoi $value))")

;; Set initial focus to text edit box.
(mode_tile "t_string" 2)

;; Run the dialog
(setq dialog-state (start_dialog))
(cond
   ;; Cancelled - restore saved data
   ((= dialog-state 0) (reset))
   ;; OK - save new data
   ((= dialog-state 1) (modify_mtext))
   ;; Pick new insertion point
   ((= dialog-state 3)
      (modify_mtext)
      (setq pt1 (getpoint (list x1 y1 z1)  "\nNew Insertion Point: "))
      (ver_pt1 0)
      (ddmtext)
   )
   ;; Run full editor
   ((= dialog-state 4)
      (modify_mtext)
      (safe_ddedit ename)
      (setq elist (entget ename))
      (ddmtext)
   )
   (T nil)
)
  )

  ;;
  ;; Modify VIEWPORT
  ;;

  (defun ddvport ()
(if (not (new_dialog "ddvport" dcl_id)) (exit))
(set_tile_props)
(set_tile_handle)
(setq vpt (cdr (assoc 10 elist)))
(set_tile "xtext" (rtos (setq x1 (car vpt))))
(set_tile "ytext" (rtos (setq y1 (cadr vpt))))
(set_tile "ztext" (rtos (setq z1 (caddr vpt))))
(setq wid (cdr (assoc 40 elist)))
(set_tile "wid" (rtos wid))
(setq hght (cdr (assoc 41 elist)))
(set_tile "hght" (rtos hght))
(setq vpid (cdr (assoc 69 elist)))
(set_tile "vpid" (itoa vpid))
(setq on-off (cdr (assoc 68 elist)))
(cond
   ((= on-off 0) (set_tile "on-off" "OFF"))
   ((> on-off 0) (set_tile "on-off" "ON and Active"))
   (T (set_tile "on-off" "ON and Inactive"))
)

;; Define action for tiles
(set_action_tiles)

(setq dialog-state (start_dialog))
(if (= dialog-state 0)
   (reset)
)
(if (= dialog-state 1)
   (progn
      (if (= ecolor 0) (setq ecolor "BYBLOCK"))
      (if (= ecolor 256) (setq ecolor "BYLAYER"))
      (command "_.chprop" ename ""
               "_la" elayer
               "_c" ecolor ""
      )
   )
)
  )
  ;;
  ;; Modify POLYLINE
  ;;
  (defun modify_polyline ()
(modify_properties)
(if (= ltgen "1")
      (if (/= (logand bit70 128) 128)
         (setq bit70 (+ bit70 128))
      )
)
(if (= ltgen "0")
      (if (= (logand bit70 128) 128)
         (setq bit70 (- bit70 128))
      )
)
(setq elist (subst (cons 70 bit70) (assoc 70 elist) elist))
(entmod elist)
;; Added to take care of updating Vertex information for color
;; and linetype.
(setq save-ename ename save-elist elist)
(if (= (cdr (assoc 0 elist)) "LWPOLYLINE")
      (progn
         (emod ecolor 62)
         (emod eltype 6)
         (emod eltscale 48)
         (entmod elist)
      )
      (progn
         (setq ename (entnext save-ename))
         (setq elist (entget ename))

         (while (not (= (cdr (assoc 0 elist)) "SEQEND"))
            (emod ecolor 62)
            (emod eltype 6)
            (emod eltscale 48)
            (entmod elist)
            (setq ename (entnext ename))
            (setq elist (entget ename))
         )
      )
)
;; Update the SEQEND
(if (= (cdr (assoc 0 elist)) "SEQEND")
   (progn
      (emod ecolor 62)
      (emod eltype 6)
      (emod eltscale 48)
      (entmod elist)
   )
)
;; Go back to header.
(setq ename save-ename elist save-elist)

(entupd ename)
  )

  ;; Increment vertex.  Set tile values to next vertex
  ;;
  (defun next_vertex ()
(if (= (cdr (assoc 0 vlist)) "LWPOLYLINE")
      (progn
         ;; If the counter reaches the number of vertices,
         ;; roll it over to zero again.
         (if (= ctr (cdr (assoc 90 vlist)))
            (setq ctr 0)
         )
            (set_tile "ctr" (itoa (setq ctr (+ 1 ctr))))
         (set_tile_vpt pointype)
      )
      (progn
         (setq vname (entnext vname))
         (setq vlist (entget vname))
         (if (= (cdr (assoc 0 vlist)) "VERTEX")
            (progn
                  (set_tile "ctr" (itoa (setq ctr (+ 1 ctr))))
                  (set_tile_vpt pointype)
            )
            (progn
                  (setq vname (entnext ename))
                  (setq vlist (entget vname))
                  (set_tile_vpt pointype)
                  (set_tile "ctr" (itoa (setq ctr 1)))
            )
         )
      )
)
  )

  (defun ddpline (/ oldecho)
(if (not (new_dialog "ddpline" dcl_id)) (exit))
(set_tile_props)
(set_tile_handle)
(setq bit70 (cdr (assoc 70 elist)))
(setq bit75 (cdr (assoc 75 elist)))
(cond
   ((= (logand bit70 8) 8) ; 3DPOLY
      (set_tile "ptype" (setq pltype "3D polyline"))
      (setq pointype 0)    ; WCS or ECS point values
      (mode_tile "fit" 1)
      (mode_tile "mesh" 1)
      (mode_tile "bezier" 1)
      (mode_tile "ltgen" 1)
      (set_tile "none" "1")
      (set_tile_closed)
      (set_tile_fitsmooth)
   )
   ((= (logand bit70 16) 16) ; 3DMESH
      (set_tile "ptype" (setq pltype "3D mesh"))
      (setq pointype 0)
      (mode_tile "pline" 1)
      (mode_tile "fit" 1)
      (mode_tile "ltgen" 1)
      (setq m (1- (cdr (assoc 71 elist))))
      (setq n (1-(cdr (assoc 72 elist))))
      (setq u (1- (cdr (assoc 73 elist))))
      (if (< u 0) (setq u 0))
      (setq v (1- (cdr (assoc 74 elist))))
      (if (< v 0) (setq v 0))
      (set_tile "m" (itoa m))
      (set_tile "n" (itoa n))
      (set_tile "u" (itoa u))
      (set_tile "v" (itoa v))
      (set_tile_closed)
      (set_tile_fitsmooth)
   )
   ((= (logand bit70 64) 64) ; POLYFACE MESH
      (set_tile "ptype" (setq pltype "Polyface mesh"))
      (setq pointype 0)
      (mode_tile "f-s" 1)
      (mode_tile "mesh" 1)
      (mode_tile "pline" 1)
   )
   (T                      ; 2D POLYLINE
      (set_tile "ptype" (setq pltype "2D polyline"))
      (setq pointype 1)
      (mode_tile "bezier" 1)
      (mode_tile "mesh" 1)
      (if (= (logand bit70 128) 128)
         (set_tile "ltgen" (setq ltgen "1"))
      )
      (set_tile_closed)
      (set_tile_fitsmooth)
   )
)

(if (= (cdr (assoc 0 elist)) "LWPOLYLINE")
      (progn
         (if (not next) (setq vname ename))
         (setq next T)
         (set_tile "ctr" (itoa (setq ctr 1)))
         (setq vlist (entget ename))
      )
      (progn
         (if (not next) (setq vname (entnext ename)))
         (setq next T)
         (set_tile "ctr" (itoa (setq ctr 1)))
         (setq vlist (entget vname))
      )
)
(set_tile_vpt pointype)
;; Define action for tiles
(set_action_tiles)
(setq dialog-state (start_dialog))

(if (= dialog-state 0)
   (reset)
)
(if (= dialog-state 1)
   (progn
      (modify_polyline)
      (if (or (= pltype "2D polyline")
            (= pltype "3D polyline")
         )
      (progn
         (command "_.pedit" ename)
         (if (= spltype 0) (command "_d"))
         (if (= spltype 1) (command "_f"))
         (if (or (= spltype 5)
                  (= spltype 6)
            )
            (progn
            (setvar "splinetype" spltype)
            (command "_s")
            )
         )
         (if (= closed "0")
            (command "_o")
            (command "_c")
         )
         (command "")

         (if (= spltype 0)
            (progn
                  (setq oldecho (getvar "cmdecho"))
                  (command "_cmdecho" 0)
                  (command "_convertpoly" "_light" ename "")
                  (command "_cmdecho" oldecho)
            )
         )
      )
      )
      (if (= pltype "3D mesh")
      (progn
         (command "_.pedit" ename)
         (if (= spltype 0) (command "_d"))
         (if (or (= spltype 5)
                  (= spltype 6)
                  (= spltype 8)
            )
            (progn
            (setvar "surftype" spltype)
            (setvar "surfu" u)
            (setvar "surfv" v)
            (command "_s")
            )
         )
         (if (/= closedm old-closedm)
            (command "_m")
         )
         (if (/= closedn old-closedn)
            (command "_n")
         )
         (command "")
      )
      )
   )
)
  )
  ;;
  ;; All the spline data is contained in a single elist. We must do some
  ;; tricky list processing to loop through the elist in order to display
  ;; all of the control points.
  ;;
  ;; The structure of the elist is different for rational and non-rational
  ;; splines. Therefore, we check the rational spline flag.
  ;;
  (defun next_cntl_pt ()
(setq elem-no 0)             ;; elem-no = element counter
(if (= first-10-time 1)       ;; If first time, find location of first
      (foreach list_item elist ;; cntl point element in elist
         (progn
            (setq elem-no (+ 1 elem-no))
            (if (= (car list_item) 10)
               (progn
                     (if (= first-10-time 1)
                        (progn
                           (setq first-10-rec (- elem-no 1))
                           (setq first-10-time 0)
                           (if (= rational_spl_flag 1) ;; if rational
                              (setq cur-10-rec (+ elem-no 1))
                              (setq cur-10-rec elem-no)
                           )
                        )
                     )
               )
            )
         )
      )
)
;; Now we know the location of the first "10" record; it's stored
;; in first-10-rec. The first 10 record was already displayed when
;; the dialog first came up so let's display the second one when
;; the user presses the "next" button (the first time through).
;;
(setq temprec (nth cur-10-rec elist))
;;
(if (= (car temprec) 10) ;; if 10 record
   (progn
      (if (= rational_spl_flag 1) ;; if rational spline
      (progn
         (setq tempweight (nth (+ cur-10-rec 1) elist))
         (setq cur-10-rec (+ 2 cur-10-rec))
      )
      (progn                      ;; else
         (setq cur-10-rec (+ 1 cur-10-rec))
      )
      )
   )                               ;; end if rational spline
   (progn                ;; else reset counters
      (setq temprec (nth first-10-rec elist))  ;; get 1st 10 rec
      (setq tempweight (nth (+ first-10-rec 1) elist))
      (setq cntl-pt-indicator 0)
      (if (= rational_spl_flag 1)          ;; if rational
         (setq cur-10-rec (+ first-10-rec 2)) ;; point to 2nd 10 rec
         (setq cur-10-rec (+ first-10-rec 1)) ;; point to 2nd 10 rec
      )
   )
)                         ;; end if 10 record

;; Display cntl point, weight and ctr. Increment ctr.
(setq cntl-pt (cdr temprec))
(set_tile "xtext" (rtos (setq x1 (car cntl-pt))))
(set_tile "ytext" (rtos (setq y1 (cadr cntl-pt))))
(set_tile "ztext" (rtos (setq z1 (caddr cntl-pt))))
(setq cntl-pt-indicator (+ 1 cntl-pt-indicator))
(set_tile "cntl_ctr" (itoa cntl-pt-indicator))
(if (= rational_spl_flag 1)                   ;; if rational
      (set_tile "weight" (rtos (cdr tempweight))) ;; disp wght
      (mode_tile "weight_text" 1)                ;; disable wght
)
  )
  ;;
  ;; All the spline info is contained in a single elist. We must do some
  ;; tricky list processing to loop through the elist in order to display
  ;; all of the user data points.
  ;;
  (defun next_data_pt ()
(setq elem-no 0)             ;; elem-no = element counter
(if (= first-11-time 1)       ;; If first time, find location of first
      (foreach list_item elist ;; data point element in elist
         (progn
            (setq elem-no (+ 1 elem-no))
            (if (= (car list_item) 11)
               (progn
                     (if (= first-11-time 1)
                        (progn
                           (setq first-11-rec (- elem-no 1))
                           (setq cur-11-rec elem-no)
                           (setq first-11-time 0)
                        )
                     )
               )
            )
         )
      )
)
(setq temprec (nth cur-11-rec elist))
;; If it's not a DXF "11" element then we've gone past the last
;; "11" element. Go back to first "11" element. Reset counters.
(if (= (car temprec) 11)
      (setq data-pt (cdr temprec))
      (progn                         ;; else
         (setq data-pt (cdr (nth first-11-rec elist)))
         (setq cur-11-rec first-11-rec)
         (setq data-pt-indicator 0)
      )
)
;; Display data point and ctr. Increment counters.
(set_tile "dxtext" (rtos (setq x1 (car data-pt))))
(set_tile "dytext" (rtos (setq y1 (cadr data-pt))))
(set_tile "dztext" (rtos (setq z1 (caddr data-pt))))
(setq data-pt-indicator (+ 1 data-pt-indicator))
(set_tile "data_ctr" (itoa data-pt-indicator))
(setq cur-11-rec (+ 1 cur-11-rec))
  )
  ;;
  ;; Modify SPLINE
  ;;
  (defun modify_spline ()
(modify_prop_geom)
(entmod elist)
  )

  (defun ddspline ()
(if (not (new_dialog "ddspline" dcl_id)) (exit))
(set_tile_props)
(set_tile_handle)
(set_tile_spline_props)
;; Display first control point
(set_tile_cntl_pt)
;; Display first data point
(set_tile_data_pt)

;; Initialize flags to indicate first time through the dialog.
;; For control points and user data points the "next" buttons
;; in the dialog call the appropriate functions.
(setq first-10-time 1)
(setq first-11-time 1)
;; initialize control point number counter
(setq cntl-pt-indicator 1)
(setq data-pt-indicator 1)
(set_tile "cntl_ctr" (itoa cntl-pt-indicator))
(set_tile "data_ctr" (itoa data-pt-indicator))
(set_action_tiles)
(setq dialog-state (start_dialog))

(if (= dialog-state 0)
   (reset)
)
(if (= dialog-state 1)
   (modify_spline)
)
  )

  ;;
  ;; Modify DIMENSION
  ;;
  (defun ddimen (/ dtypebit blkname bename sublist a stname n dimtbl
               dimsty dimlist dimtext svtext dimovr sv_dvlist stlist
               dimtype dimsvcurset)
(setq dimtype "DDIMEN"
      dimsvcurset (ddimen_dimsty_restore)
)
(if (not (new_dialog "ddimen" dcl_id)) (exit))
(set_tile_props)
(set_dimen_props)
(setq dimtext (cdr (assoc 1 elist)))
(set_tile "t_string" (if (= "" dimtext) "<>" dimtext))
(set_tile_handle)
;; Define action for tiles
(set_action_tiles)

;; Set initial focus to text edit box.
(mode_tile "t_string" 2)

(setq dialog-state (start_dialog))
(if (= dialog-state 0)
   (if (= ddimmt 1)
      (reset)
   )
)
(if (= dialog-state 1)
   (progn
      (if (/= dimsty stname)
      (progn
         ; Be sure to add (3 . dimstylename) element. R12 *UNNAMED case
         ; doesn't have it.
         (if (null (assoc 3 elist))
            (setq elist (append elist (list (cons 3 dimsty))))
            ; else just replace it.
            (setq elist (subst (cons 3 dimsty) (assoc 3 elist) elist))
         )
         ; refresh sv_dvlist with new dimstyle.
         (setq sv_dvlist (tblsearch "dimstyle" dimsty))
      )
      )
      (if (not (null dimlist)) ; attempted to change dimvars
      (ddimen_complist sv_dvlist dimlist dimtbl)
      )
      ; Modify dimension text
      (if (/= dimtext text)
      (progn
         (setq dimtext (if (= text "<>") "" text))
         (setq elist (subst (cons 1 dimtext) (assoc 1 elist) elist))
      )
      )
      (modify_properties)
      (entmod elist)
   )
)
(if (= dialog-state 4)
   (progn
      (setq ddimmt 1)
      (if (/= dimsty stname)
      (progn
         ; Be sure to add (3 . dimstylename) element. R12 *UNNAMED case
         ; doesn't have it.
         (if (null (assoc 3 elist))
            (setq elist (append elist (list (cons 3 dimsty))))
            ; else just replace it.
            (setq elist (subst (cons 3 dimsty) (assoc 3 elist) elist))
         )
         ; refresh sv_dvlist with new dimstyle.
         (setq sv_dvlist (tblsearch "dimstyle" dimsty))
      )
      )
      (if (not (null dimlist)) ; attempted to change dimvars
      (ddimen_complist sv_dvlist dimlist dimtbl)
      )
      ; Modify dimension text
      (if (/= dimtext text)
      (progn
         (setq dimtext (if (= text "<>") "" text))
         (setq elist (subst (cons 1 dimtext) (assoc 1 elist) elist))
      )
      )
      (modify_properties)
      (entmod elist)
      (safe_ddedit ename)
      (setq elist (entget ename))
      (ddimen)
   )
)
(ddimen_setvars dimsvcurset)    ; Prepare to exit
  )

  ;;
  ;; Modify TOLERANCE
  ;;
  (defun ddtolerance (/ a stname n dimtbl
               dimsty dimlist dimovr sv_dvlist stlist dimtype
               dimsvcurset)
(setq dimtype "DDTOLERANCE"
      dimsvcurset (ddimen_dimsty_restore)
)
(if (not (new_dialog "ddtolerance" dcl_id)) (exit))
(set_tile_props)
(set_dimen_props)
(set_tile_handle)
(set_action_tiles)
(setq dialog-state (start_dialog))
(if (= dialog-state 0)
   (if (= ddimmt 1)
      (reset)
   )
)
(if (= dialog-state 1)
   (progn
      (if (/= dimsty stname)
      (progn
         ; Be sure to add (3 . dimstylename) element. R12 *UNNAMED case
         ; doesn't have it.
         (if (null (assoc 3 elist))
            (setq elist (append elist (list (cons 3 dimsty))))
            ; else just replace it.
            (setq elist (subst (cons 3 dimsty) (assoc 3 elist) elist))
         )
         ; refresh sv_dvlist with new dimstyle.
         (setq sv_dvlist (tblsearch "dimstyle" dimsty))
      )
      )
      (if (not (null dimlist)) ; attempted to change dimvars
      (ddimen_complist sv_dvlist dimlist dimtbl)
      )
      (modify_prop_geom)
      (entmod elist)
   )
)
(if (= dialog-state 4)
   (progn
      (setq ddimmt 1)
      (if (/= dimsty stname)
      (progn
         ; Be sure to add (3 . dimstylename) element. R12 *UNNAMED case
         ; doesn't have it.
         (if (null (assoc 3 elist))
            (setq elist (append elist (list (cons 3 dimsty))))
            ; else just replace it.
            (setq elist (subst (cons 3 dimsty) (assoc 3 elist) elist))
         )
         ; refresh sv_dvlist with new dimstyle.
         (setq sv_dvlist (tblsearch "dimstyle" dimsty))
      )
      )
      (if (not (null dimlist)) ; attempted to change dimvars
      (ddimen_complist sv_dvlist dimlist dimtbl)
      )
      (modify_properties)
      (entmod elist)
      (safe_ddedit ename)
      (setq elist (entget ename))
      (ddtolerance)
   )
)
(ddimen_setvars dimsvcurset)    ; Prepare to exit
)

  ;;
  ;; ddimen_dlg - jump to ADS ddim module
  ;;

  (defun ddimen_dlg (dimtype tile dimsty dvlist / dimlist)

; Jump to DDIM with overrides if any.
(cond ((= tile 11) (setq dimlist (c:ddim "DDMODIFY" dimtype tile dimsty dvlist))) ; Geometry
      ((= tile 12) (setq dimlist (c:ddim "DDMODIFY" dimtype tile dimsty dvlist))) ; Format
      ((= tile 13) (setq dimlist (c:ddim "DDMODIFY" dimtype tile dimsty dvlist))) ; Annotation
)
  )

  ;;
  ;; Dimension variables updated are stored as overrides.
  ;;

  (defun ddimen_complist (dimolist dimnlist dimtbl / i odvar ndvar
                        dv dime commandIssued)

; Here we skip the following first three items:
; (0 . "DIMSTYLE") (2 . sylename) (70 . 0)
;
; The list comparison immediately begins with dimvar.
;
;  dimolist - original states of dimvars
;  dimnlist - new dimvar list which is of the resbuf's
;  dime - entity name for the dimension
;  odvar - value of dimvar for the dimolist
;  ndvar - value of dimvar for the dimnlist

(setq i 3
      dime (cdr (assoc -1 elist))
)
(while (setq odvar (cdr (nth i dimolist)))
   (progn
      (setq ndvar (cdr (nth i dimnlist)))
      (setq dv (nth i dimtbl))
      (if (eq dv "dimtxsty")
         (setq odvar (cdr (assoc 2 (entget odvar)))
               ndvar (cdr (assoc 2 (entget ndvar)))
         )
      )

            ;
            ; In order for DIMOVERRRIDE to operate correctly with string
            ; based dimvars, we must pass "." versus NULL strings.
            ; In this case ndvar is the new dimvar value the user wishes
            ; to update on selected dimensions.
            ;
         (if (/= ndvar odvar)
            (if (= 'STR (type ndvar))
            (if (= ndvar "")
                  (setq ndvar "."))))

      (if (/= ndvar odvar)
      (progn
         (setq dv (strcat "_" dv))
         ;
         ; Start the dimoverride command
         ;
         (if (not commandIssued)
            (progn
               (command "_.dimoverride")
               (setq commandIssued "T")
            )
         )
         ;
         ; Issue dim overrides
         ;
         (if (and (or (= dv "_dimclrd") (= dv "_dimclrt") (= dv "_dimclre"))
                  (or (= ndvar 0) (= ndvar 256))
            )
            (progn
            (if (= 0 ndvar) (command dv "BYBLOCK"))
            (if (= 256 ndvar) (command dv "BYLAYER"))
            )
            (command dv ndvar)
         )
      )
      )
      (setq i (1+ i))
   )
)
;
; Select Entity and terminate command
;
(if commandIssued
      (command "" dime "")
)
  )

  ;;
  ;; Get style name currently selected style name.
  ;;

  (defun ddimen_style (/ dimsty)
(setq dimsty (nth (atoi (get_tile "mod_style")) stlist)
      dimlist (ddimen_getdimvars dimsty)
)
dimsty
  )

  ;;
  ;; Set dimvars
  ;;
  (defun ddimen_setvars (dimsvcurset / dv i)
(setq dv (cdr (nth 1 dimsvcurset)))
(command "_.dimstyle" "" dv)
(setq i 3)
(while (setq dv (nth i dimsvcurset))
   (progn
      (setvar (car dv) (cdr dv))
      (setq i (1+ i))
   )
)
  )
  ;;
  ;;  End-of-dimension
  ;; ==================

  ;;
  ;; Sub-dialogues for properties.  Common to all object dialogues
  ;;
  ;; This function pops a dialogue box consisting of a list box,image tile, and
  ;; edit box to allow the user to select or type a color number.  It returns
  ;; the color number selected.
  (defun getcolor (/ old-idx colorno cname lay_clr)
(if (= (get_tile "error") "")
   (progn
      ;; Get the color associated with this object's layer, for use
      ;; in the color swatch if the user selects color BYLAYER.
      (setq lay_clr (cdr (assoc 62 (tblsearch "layer" elayer))))
      (if (numberp (setq temp_color (acad_colordlg ecolor T lay_clr)))
      (progn
         (setq ecolor temp_color)
         (setcolor)
      )
      (setq testcolor temp_color)
      )
   )
)
ecolor
  )
  ;;
  ;; Function to set the color tiles.
  (defun setcolor()
(cond
   ((= 0 ecolor)
      (set_tile "t_color" "BYBLOCK")
      (col_tile "show_image" 7 nil) ; show BYBLOCK as white
   )
   ((= 1 ecolor)
      (set_tile "t_color" "1 red")
      (col_tile "show_image" 1 nil)
   )
   ((= 2 ecolor)
      (set_tile "t_color" "2 yellow")
      (col_tile "show_image" 2 nil)
   )
   ((= 3 ecolor)
      (set_tile "t_color" "3 green")
      (col_tile "show_image" 3 nil)
   )
   ((= 4 ecolor)
      (set_tile "t_color" "4 cyan")
      (col_tile "show_image" 4 nil)
   )
   ((= 5 ecolor)
      (set_tile "t_color" "5 blue")
      (col_tile "show_image" 5 nil)
   )
   ((= 6 ecolor)
      (set_tile "t_color" "6 magenta")
      (col_tile "show_image" 6 nil)
   )
   ((= 7 ecolor)
      (set_tile "t_color" "7 white")
      (col_tile "show_image" 7 nil)
   )
   ((= 256 ecolor)
      (set_tile "t_color" "BYLAYER")
      (col_tile "show_image" (bylayer_col) nil)
   )
   (T
      (set_tile "t_color" (itoa ecolor))
      (col_tile "show_image" ecolor nil)
   )
)
  )
  ;;
  ;; This function pops a dialogue box consisting of a list box, image tile, and
  ;; edit box to allow the user to select or  type a linetype.  It returns the
  ;; linetype selected.
  ;;
  (defun getltype (/ old-idx ltname)
(if (not lt-idx)
   (progn
      (make_lt_lists)          ; linetype lists - ltnmlst, mdashlist
      (cond
      ((= eltype "BYLAYER")
         (setq lt-idx (getindex "BYLAYER" ltnmlst)))
      ((= eltype "BYBLOCK")
         (setq lt-idx (getindex "BYBLOCK" ltnmlst)))
      (T (setq lt-idx (getindex eltype ltnmlst)))
      )
   )
)

(if (= (get_tile "error") "")
   (progn
   (if (not (new_dialog "setltype" dcl_id)) (exit))
   (start_list "list_lt")
   (mapcar 'add_list ltnmlst)  ; initialize list box
   (end_list)
   (setq old-idx lt-idx)
   (ltlist_act (itoa lt-idx))

   (action_tile "list_lt" "(ltlist_act $value)")
   (action_tile "edit_lt" "(ltedit_act $value)")
   (action_tile "accept" "(test_ok)")
   (action_tile "cancel" "(reset_lt)")

   (if (= (start_dialog) 1) ; User pressed OK
      (cond
      ((= lt-idx 0)
         (set_tile "t_ltype" (bylayer_lt))
         "BYLAYER"
      )
      ((= lt-idx 1)
         (set_tile "t_ltype" "BYBLOCK")
         "BYBLOCK"
      )
      (T  (set_tile "t_ltype" ltname) ltname)
      )
      eltype
   )
   )
   eltype
)
  )
  ;;
  ;; Edit box entries end up here
  (defun ltedit_act (ltvalue)
(setq ltvalue (xstrcase ltvalue))
(if (or (= ltvalue "BYLAYER")
         (= ltvalue "BY LAYER"))
   (setq ltvalue "BYLAYER")
)
(if (or (= ltvalue "BYBLOCK")
         (= ltvalue "BY BLOCK"))
   (setq ltvalue "BYBLOCK")
)
(if (setq lt-idx (getindex ltvalue ltnmlst))
   (progn
      (set_tile "error" "")
      (ltlist_act (itoa lt-idx))
   )
   (progn
      (set_tile "error" "Invalid linetype.")
      (setq lt-idx old-idx)
;;       (mode_tile "edit_lt" 2)
;;       (mode_tile "edit_lt" 3)
   )
)
  )
  ;;
  ;; List selections end up here.  Update the list box, edit box, and color
  ;; tile.
  ;;
  (defun ltlist_act (index / dashdata)
(set_tile "error" "")
(setq lt-idx (atoi index))
(setq ltname (nth lt-idx ltnmlst))
(setq dashdata (nth lt-idx mdashlist))
(col_tile "show_image" 0 dashdata)
(set_tile "list_lt" (itoa lt-idx))
(set_tile "edit_lt" ltname)
  )
  ;;
  ;; Reset to original linetype when cancel it selected
  ;;
  (defun reset_lt ()
(setq lt-idx old-idx)
(done_dialog 0)
  )
  ;;
  ;; This function pops a dialogue box consisting of a list box,image tile, and
  ;; edit box to allow the user to select or type a layer name.  It returns the
  ;; layer name selected.  It also has a button to find the status (On, Off,
  ;; Frozen, etc.) of any layer selected.
  ;;
  (defun getlayer (/ old-idx layname on off frozth linetype)
;; Create layer list the first time the layer
;; dialogue is called.
(if (not lay-idx)
   (progn
      (make_lay_lists)
      (setq lay-idx (getindex elayer laynmlst))
   )
)

(if (= (get_tile "error") "")
   (progn
   (if (not (new_dialog "setlayer" dcl_id)) (exit))
   (set_tile "cur_layer" (getvar "clayer"))
   (start_list "list_lay")
   (mapcar 'add_list laynmlst)  ; initialize list box
   (end_list)
   (setq old-idx lay-idx)
   (laylist_act (itoa lay-idx))
   (action_tile "list_lay" "(laylist_act $value)")
   (action_tile "edit_lay" "(layedit_act $value)")
   (action_tile "accept" "(test_ok)")
   (action_tile "cancel" "(reset_lay)")
   (if (= (start_dialog) 1) ; User pressed OK
      (progn
      (set_tile "t_layer" layname)
      (setq elayer layname)
      ;; If layer equals bylayer reset color tile
      (if (= ecolor 256)
         (col_tile "show_image" (bylayer_col) nil)
      )
      layname
      )
      elayer
   )
   )
   elayer
)
  )
  ;;
  ;; Edit box selections end up here.  Convert layer entry to upper case.  If
  ;; layer name is valid, clear error string, call (laylist_act) function.
  ;; Else print error message.
  ;;
  (defun layedit_act (layvalue)
(setq layvalue (xstrcase layvalue))
(if (setq lay-idx (getindex layvalue laynmlst))
   (progn
      (set_tile "error" "")
      (laylist_act (itoa lay-idx))
   )
   (progn
      (set_tile "error" "Invalid layer name.")
;;       (mode_tile "edit_lay" 2)
;;       (mode_tile "edit_lay" 3)
      (setq lay-idx old-idx)
   )
)
  )
  ;;
  ;; List entry selections end up here.
  ;;
  (defun laylist_act (index / layinfo color dashdata)
;; Update the list box, edit box, and color tile.
(set_tile "error" "")
(setq lay-idx (atoi index))
(setq layname (nth lay-idx laynmlst))
(setq layinfo (tblsearch "layer" layname))
(setq color (cdr (assoc 62 layinfo)))
(setq color (abs color))
(setq colname (colorname color))
(set_tile "list_lay" (itoa lay-idx))
(set_tile "edit_lay" layname)
  )
  ;;
  ;; Reset to original layer when cancel is selected.
  ;;
  (defun reset_lay ()
(setq lay-idx old-idx)
(done_dialog 0)
  )
  ;;
  ;; Checks validity of thickness from edit box.
  (defun getthickness (value)
(setq ethickness (verify_d "eb_thickness" value ethickness))
  )
  ;;
  ;; Copy of (getthickness) for ltscale.  If more, make this function
  ;; generic.
  (defun getltscale (value)
(setq eltscale (verify_d "eb_ltscale" value eltscale))
  )
  ;;
  ;; This function makes a list called laynmlst which consists of all the layer
  ;; names in the drawing.  It also creates a list called longlist which
  ;; consists of strings which contain the layer name, color, linetype, etc.
  ;; Longlist is later mapped into the layer listbox.  Both are ordered the
  ;; same.
  ;;
  (defun make_lay_lists (/ layname sortlist name templist layer_number)
(setq sortlist nil)
(setq templist (tblnext "LAYER" T))
(setq layer_number 1)
(while templist
   ;; No xref dependent layers, please.
      (if (/= (logand 16 (cdr (assoc 70 templist))) 16)
         (progn
            (setq name (cdr (assoc 2 templist)))
      (setq sortlist (cons name sortlist))
      )
      )
      ; Get the next layer.
   (setq templist (tblnext "LAYER"))
   ;; Not dead message...
   (if (= (/ layer_number 50.0) (fix (/ layer_number 50.0)))
      (set_tile "error" (strcat "Collecting..." (itoa layer_number)))
   )
   (setq layer_number (1+ layer_number))
)
(set_tile "error" "")
(if (>= (getvar "maxsort") (length sortlist))
   (progn
      (if (> layer_number 50)
      (set_tile "error" "Sorting...")
      )
      (setq sortlist (acad_strlsort sortlist))
   )
   (setq sortlist (reverse sortlist))
)
(set_tile "error" "")
(setq laynmlst sortlist)
  )
  ;;
  ;; This function makes 2 list - ltnmlst & mdashlist.
  ;; Ltnmlst is a list of linetype names read from the symbol table.  Mdashlist
  ;; is list consisting of lists which define the linetype pattern - numbers
  ;; that indicate dots, dashes, and spaces taken from group code 49.  The list
  ;; corresponds to the order of names in ltnmlst.
  ;;
  (defun make_lt_lists (/ ltlist ltname)
(setq mdashlist nil)
      (setq sortlist nil)
      (setq ltype_number 1)
(setq ltlist (tblnext "LTYPE" T))
;;(setq ltname (cdr (assoc 2 ltlist)))
;;(setq ltnmlst (list ltname))
(while ltlist
      ;; No xref dependent linetypes, please.
      (if (/= (logand 16 (cdr (assoc 70 ltlist))) 16)
         (progn
      (setq ltname (cdr (assoc 2 ltlist)))
      (setq sortlist (cons ltname sortlist))
         )
      )
      ;; Get the next linetype.
      (setq ltlist (tblnext "LTYPE"))

      ;; Not dead message...
   (if (= (/ ltype_number 50.0) (fix (/ ltype_number 50.0)))
      (set_tile "error" (strcat "Collecting..." (itoa ltype_number)))
   )
   (setq ltype_number (1+ ltype_number))

)

      ;; Remove Collecting message.
      (set_tile "error" "")

;; Sort based on maxsort.
      (if (>= (getvar "maxsort") (length sortlist))
   (progn
      (if (> ltype_number 50)
      (set_tile "error" "Sorting...")
      )
      (setq sortlist (acad_strlsort sortlist))
   )
   (setq sortlist (reverse sortlist))
)
(set_tile "error" "")
(setq ltnmlst sortlist)

(foreach ltname ltnmlst
   (setq ltlist (tblsearch "LTYPE" ltname))
   (if (= ltname "CONTINUOUS")
      (setq mdashlist (append mdashlist (list "CONT")))
      (setq mdashlist
         (append mdashlist (list (add_mdash ltlist)))
      )
   )
)
(setq ltnmlst (cons "BYBLOCK" ltnmlst))
(setq mdashlist  (cons nil mdashlist))
(setq ltnmlst (cons "BYLAYER" ltnmlst))
(setq mdashlist  (cons nil mdashlist))
  )
  ;;
  ;; Get all the group code 49 values for a linetype and put them in a list
  ;; (pen-up, pen-down info).
  ;;
  (defun add_mdash (ltlist1 / dashlist assoclist dashsize)
(setq dashlist nil)
(while (setq assoclist (car ltlist1))
   (if (= (car assoclist) 49)
      (progn
      (setq dashsize (cdr assoclist))
      (setq dashlist (cons dashsize dashlist))
      )
   )
   (setq ltlist1 (cdr ltlist1))
)
(setq dashlist (reverse dashlist))
  )
  ;;
  ;; Color a tile, draw linetype, and draw a border around it
  ;;
  (defun col_tile (tile color patlist / x y)
(setq x (dimx_tile tile))
(setq y (dimy_tile tile))
(start_image tile)
(fill_image 0 0 x y color)
(if (= color 7)
   (progn
      (if patlist (drawpattern x (/ y 2) patlist 0))
      (tile_rect 0 0 x y 0)
   )
   (progn
      (if patlist (drawpattern x (/ y 2) patlist 7))
      (tile_rect 0 0 x y 7)
   )
)
(end_image)
  )
  ;;
  ;; Draw a border around a tile
  ;;
  (defun tile_rect (x1 y1 x2 y2 color)
(setq x2 (- x2 1))
(setq y2 (- y2 1))
(vector_image x1 y1 x2 y1 color)
(vector_image x2 y1 x2 y2 color)
(vector_image x2 y2 x1 y2 color)
(vector_image x1 y2 x1 y1 color)
  )
  ;;
  ;; Draw the linetype pattern in a tile.  Boxlength is the length of the image
  ;; tile, y2 is the midpoint of the height of the image tile, pattern is a
  ;; list of numbers that define the linetype, and color is the color of the
  ;; tile.
  ;;
  (defun drawpattern (boxlength y2 pattern color / x1 x2
                  patlist dash)
(setq x1 0 x2 0)
(setq patlist pattern)
(setq fx 30)
(if (= patlist "CONT")
   (progn (setq dash boxlength)
      (vi)
      (setq x1 boxlength)
   )
   (foreach dash patlist
      (if (> (abs dash) 2.5)
      (setq fx 2)
      )
   )
)
(while (< x1 boxlength)
   (if (setq dash (car patlist))
      (progn
      (setq dash (fix (* fx dash)))
      (cond
         ((= dash 0) (setq dash 1) (vi))
         ((> dash 0) (vi))
         (T
            (if (< (abs dash) 2)
            (setq dash 2)
            )
            (setq x2 (+ x2 (abs dash)))
         )
      )
      (setq patlist (cdr patlist))
      (setq x1 x2)
      )
      (setq patlist pattern)
   )
)
  )
  ;;
  ;; Determain state of xclip
  ;; Returns the group 71 value of the spacial filter dictionary.
  ;; If the entity doesn't have a spacial filter dictionary, this
  ;; returns 0. If it does it will return 0 or 1 depending on the
  ;; current setting of the state of the clipping visibility.
  ;;
  (defun xclipon(elist)
(setq hasclip T)
(if (/= (assoc 360 elist) nil)
   (progn
      (setq tmp (entget(cdr(assoc 360 elist))))
      (if (/= nil (assoc 360 tmp))
      (progn
         (setq tmp (entget(cdr(assoc 360 tmp))))
         (if (/= nil (assoc 360 tmp))
            (progn
            (setq tmp (entget(cdr(assoc 360 tmp))))
            (if (/= nil (assoc 71 tmp))
               (cdr(assoc 71 tmp))
                              (progn
                                    (setq hasclip nil)
                                    (eval 0)
                              )
            )
            )
                        (progn
                              (setq hasclip nil)
                              (eval 0)
                        )
         )
      )
               (progn
                     (setq hasclip nil)
                     (eval 0)
               )
      )
   )
      (progn
            (setq hasclip nil)
            (eval 0)
      )
)
  )
  ;;
  ;; Draw a dash or dot in image tile
  ;;
  (defun vi ()
(setq x2 (+ x2 dash))
(vector_image x1 y2 x2 y2 color)
  )
  ;;
  ;; If an item is a member of the list, then return its index number, else
  ;; return nil.
  ;;
  (defun getindex (item itemlist / m n)
(setq n (length itemlist))
(if (> (setq m (length (member item itemlist))) 0)
   (- n m)
   nil
)
  )
  ;;
  ;; This function is called if the linetype is set "BYLAYER". It finds the
  ;; ltype of the layer so it can be displayed  beside the linetype button.
  ;;
  (defun bylayer_lt (/ layname layinfo ltype)
(if lay-idx
   (progn
      (setq layname (nth lay-idx laynmlst))
      (setq layinfo (tblsearch "layer" layname))
      (setq ltype (cdr (assoc 6 layinfo)))
      "BYLAYER"
   )
   "BYLAYER"
)
  )
  ;;
  ;; This function is called if the color is set "BYLAYER".  It finds the color
  ;; of the layer so it can be displayed beside the color button.
  ;;
  (defun bylayer_col (/ layname layinfo color)
(setq layinfo (tblsearch "layer" elayer))
(setq color (abs (cdr (assoc 62 layinfo))))
  )
  ;;
  ;; Used to set the color name in layer subdialogue.
  ;;
  (defun colorname (colnum / cn)
(setq cn (abs colnum))
(cond ((= cn 1) "red")
      ((= cn 2) "yellow")
      ((= cn 3) "green")
      ((= cn 4) "cyan")
      ((= cn 5) "blue")
      ((= cn 6) "magenta")
      ((= cn 7) "white")
      (T (itoa cn))
)
  )
  ;;
  ;; If their is no error message, then close the dialogue.
  ;;
  (defun dismiss_dialog (action)
(if (= action 0)
   (done_dialog 0)
   (if (= (get_tile "error") "")
      (done_dialog action)
   )
)
  )

  (defun test_ok ()
(if (= (get_tile "error") "")
   (done_dialog 1)
)
  )

  (defun cancel ()
(done_dialog 0)
  )

;;; =======================================================================
;;; SETUP layer and linetype lists for application, and initialize all
;;; program variables.

  (setq elist    (entget ename)
      old-elist elist
      modlist    elist
      etype    (strcase (cdr (assoc 0 elist)))
      ecolor    (cdr (assoc 62 elist))
      elayer    (cdr (assoc 8 elist))
      eltscale (cdr (assoc 48 elist))
      ethickness  (cdr (assoc 39 elist))
      eltype    (cdr (assoc 6 elist))
  )
  (if (= (assoc 210 elist) nil)
(setq extru (list 0.0 0.0 1.0))
(setq extru (cdr (assoc 210 elist)))
  )

  (if (not ecolor) (setq ecolor 256))
  (if (not eltype) (setq eltype "BYLAYER"))
  (if (not ethickness) (setq ethickness 0))
  (if (not eltscale) (setq eltscale 1))
) ; end ddmodify_init

;;; --------------------------------------------------------------------------
;;; Function: DDMODIFY_SELECT
;;;
;;; Object aquisition function.
;;;
;;; (ddmodify_select)
;;;
;;; Obtains object to be modified, in one of three ways:
;;;
;;; 1 - Autoselected.
;;; 2 - Prompted for.
;;; 3 - Passed as an argument in a call to (ddmodify <ename> )
;;;
;;; The (ddmodify_select) function also sets the value of the
;;; global symbol AI_SELTYPE to one of the above three values to
;;; indicate the method thru which the object was aquired.
;;;
;;; This value can be useful to applications that want to RESTORE
;;; an object that was autoselected to its previous selected state
;;; when they terminate, although there doesn't appear to be any
;;; way to do this right now.

(defun ddmodify_select ()
(cond
   (  ename                            ; (ddmodify) was called
      (cond                            ; with an <ename> argument
         (  (entget ename)             ; If object is non-deleted
            (setq ai_seltype 3)       ; then return its ename.
            (ai_return ename))))

   ;; return auto-selected , see ai_utils.lsp
   (  (ai_autossget1 "\nSelect one object to modify: "))

   (t (princ "\nNothing selected.")
      (ai_return nil))
)
)

;;; ============= Command line interface function =======================

(defun C:MMO ()
(ddmodify nil)
(princ)
)

;;; ================== (ddmodify) - Main program ========================
;;;
;;; (ddmodify <ename> )
;;;
;;; Main program function, callable as a subroutine.
;;;
;;; <ename> = object name of the object to modify.
;;;
;;; If <ename> is nil, then user is prompted to select
;;; the object interactively.
;;;
;;; Before (ddmodify) can be called as a subroutine, it must
;;; be loaded first.  It is up to the calling application to
;;; first determine this, and load it if necessary.

(defun ddmodify (ename /
2ndpt             ell_calc_area          move_pt1             templist
add_mdash       ell_tile                n                   tempmod
alipt             eltscale                name                tempst_ang
ang             eltype                newpoint             test_ok
arc_calc          emod                   next                text
arclen          end_ang                next_vertex          th-value
assoclist       endpt                   obl                   tile
atprompt          errchk                off                   tile_rect
attag             ethickness             old_majrad          tilemode
attprompt       etype                   old-closed          totang
bit             extru                   old-closedm          tstyle
bit1             fchk                   old-closedn          u
bit-10          first-10-rec          old-elist             undo_init
bit-11          first-10-time          olderr                upsd
bit2             first-11-rec          old-fit             v
bit3             first-11-time          old-idx             va
bit4             fit                   oldlist             value
bit70             frozth                old-spltype          ver_4
bit-70          f-vis                   old-u                ver_ang1
bit75             fx                      old-v                ver_ang2
bk-up             get_color             on                   ver_col
bkwd             getcolor                onoff                ver_colsp
boxlength       getindex                on-off                ver_eangle
bylayer_col       getlayer                patlist             ver_hght
bylayer_lt       getltype                pattern             ver_majrad
calc             getthickness          pltype                ver_obl
cancel          globals                polytype             ver_pt1
cir_calc          ha                      pre                   ver_pt2
closed          ha-prev                proplist             ver_pt3
closedm          help_entry             pt                   ver_pt4
closedn          hght                   pt1                   ver_rad
cmd             icvp                   pt1_eq_pt2          ver_rot
cn                image_add_vector       pt2                   ver_row
cname             image_clean_variables pt3                   ver_rowsp
cntl-pt-indicator  image_cross_product    pt4                   ver_tag
code_71          image_disp_opt          ptype                ver_u
col_tile          image_dot_product       radius                ver_v
col-idx          image_normalize_vector rational_spl_flag    ver_wid
colname          image_rotate_vector    reset                ver_x1
colnmlst          image_scale             reset_flag          ver_x2
colnolst          image_scale_vector    reset_lay             ver_x3
colnum          image_update          reset_lt             ver_x4
color             index                   reset_uv             ver_xline_pt1
colorname       inv                   rot                   ver_xline_pt2
colorno          item                   rows                ver_xline_x1
col-sp          item1                   row-sp                ver_xline_x2
columns          item2                   rrat                ver_xline_y1
con             itemlist                s                   ver_xline_y2
coord             jlist                   set_action_tiles    ver_xline_z1
ctr             jlist_act             set_just_idx          ver_xline_z2
cur-10-rec       just-idx                set_tile_bk-up       ver_xscl
cur-11-rec       layedit_act             set_tile_cntl_pt    ver_y1
cvpname          lay-idx                set_tile_data_pt    ver_y2
dash             layinfo                set_tile_dirv       ver_y3
dashdata          laylist                set_tile_edges       ver_y4
dashlist          laylist_act             set_tile_endang       ver_yscl
dashsize          layname                set_tile_hght       ver_z1
data-pt-indicator  laynmlst                set_tile_icvp       ver_z2
dcl_id          layvalue                set_tile_just       ver_z3
dd3dface          line_calc             set_tile_obl          ver_zscl
dd3dsolid       linetype                set_tile_prompt       verify_a
ddarc             list1                   set_tile_props       verify_d
ddblock          longlist                set_tile_pt1          verify_i
ddbody          ltabstr                set_tile_pt2          verify_xline
ddcircle          ltedit_act             set_tile_pt3          vfy
ddellipse       ltidx                   set_tile_pt4          vi
ddgetprompt       lt-idx                set_tile_rad          vlist
ddgettext       ltlist                set_tile_rc          vname
ddimage          ltlist_act             set_tile_rot          vpf
ddimen          ltlist1                set_tile_scale       vpid
ddleader          ltname                set_tile_spline_props  vpldata
ddline          ltnmlst                set_tile_stang       vpn
ddlist          ltvalue                set_tile_style       vpt
ddmline          ltype                   set_tile_tag          which_tiles
ddmodify_err    m                      set_tile_text       wid
ddmtext          majrad                set_tile_vpt          x
ddpline          make_lay_lists          set_tile_wid          x1
ddpoint          make_lt_lists          set_tile_xline_pt1    x2
ddray             mdashlist             set_tile_xline_pt2    x3
ddregion          minrad                setcolor             x4
ddshape          modify_3dface          shght                xdlist
ddsolid          modify_3dsolid          showpt                xline_pt1
ddspline          modify_arc             size                xline_pt2
ddtext          modify_block          slist                xline_x1
ddvport          modify_body             sname                xline_x2
ddxline          modify_circle          sortlist             xline_y1
denom             modify_ellipse          spltype             xline_y2
dialog-state    modify_image          ss                   xline_z1
dir_pt          modify_line             st_ang                xline_z2
dir_ptx          modify_mline          stpt                xscale
dir_pty          modify_mtext          style_act             xx
dir_ptz          modify_point          style-idx             y
dismiss_dialog    modify_polyline       style-list          y1
drawpattern       modify_prop_geom       tagval                y2
echo             modify_properties       temp                y3
ecolor          modify_ray             temp_color          y4
edge1             modify_region          temp_dir_x          yscale
edge2             modify_shape          temp_dir_y          yy
edge3             modify_solid          temp_dir_z          z1
edge4             modify_spline          temp_xline_pt1       z2
edgetest          modify_text             temp_xline_x1       z3
elayer          modify_vport          temp_xline_y1       z4
elist             modify_xline          temp_xline_z1       zscale
ell_calc          modlist                tempend_eang          zz
dir-idx          safe_ddedit             ver_MtextWidth       xcliponoff
MText_style
  )

  (setq old_cmd (getvar "cmdecho") ; save current setting of cmdecho
      old_error  *error*          ; save current error function
      *error* ai_error             ; new error function
  )

  (setq old_pickstyle (getvar "PICKSTYLE"))       ; save old pickstyle
  (setq new_pickstyle (logand old_pickstyle (~ 1)))  ; turn off group selection
  (setvar "pickstyle" new_pickstyle)                ; bit and set to new value

  (setvar "cmdecho" (cond (  (or (not *debug*) (zerop *debug*)) 0)
                        (t 1)))
  (cond
   (  (not (ai_notrans)))                   ; Not transparent?
   (  (not (ai_acadapp)))                   ; ACADAPP.EXP xloaded?
   (  (not (setq dcl_id (ai_dcl "ddmodify")))) ; is .DLG file loaded?
   (  (not (setq ename (ddmodify_select)))) ; object to modify?

   (t (ai_undo_push)
      (ddmodify_init)                         ; everything okay, proceed.
      (cond
         ((= etype "LEADER")
         (setq help_entry  "modify_Leader_dialog")
         (ddleader)
         )
         ((= etype "ARC")
         (setq help_entry  "modify_Arc_dialog")
         (ddarc)
         )
         ((= etype "ATTDEF")
         (setq help_entry  "modify_Attribute_Definition_dialog")
         (ddtext)
         )
         ((= etype "CIRCLE")
         (setq help_entry  "modify_Circle_dialog")
         (ddcircle)
         )
         ((= etype "ELLIPSE")
         (setq help_entry  "modify_Ellipse_dialog")
         (ddellipse)
         )
         ((= etype "3DSOLID")
         (setq help_entry  "modify_3d_Solid_dialog")
         (dd3dsolid)
         )
         ((= etype "BODY")
         (setq help_entry  "modify_Body_dialog")
         (ddbody)
         )
         ((= etype "REGION")
         (setq help_entry  "modify_Region_dialog")
         (ddregion)
         )
         ((= etype "HATCH")
         (setq help_entry  "modify_Hatch_dialog")
         (ddnewhatch)
         )
         ((= etype "SPLINE")
         (setq help_entry  "modify_Spline_dialog")
         (ddspline)
         )
         ((= etype "INSERT") ; see ddblock for help_entry
         (ddblock)
         )
         ((= etype "LINE")
         (setq help_entry  "modify_Line_dialog")
         (ddline)
         )
         ((= etype "MLINE")
         (setq help_entry  "modify_multiLine_dialog")
         (ddmline)
         )
         ((= etype "RAY")
         (setq help_entry  "modify_Ray_dialog")
         (ddxline)
         )
         ((= etype "XLINE")
         (setq help_entry  "modify_Xline_dialog")
         (ddxline)
         )
         ((= etype "POINT")
         (setq help_entry  "modify_Point_dialog")
         (ddpoint)
         )
         ((or (= etype "POLYLINE") (= etype "LWPOLYLINE"))
         (setq help_entry  "modify_Polyline_dialog")
         ;; If a 2D pline, check to see if it is planar to the current
         ;; UCS, reject if not. To see if the pline is parallel,
         ;; the 210 group (WCS) is added to the current UCS origin (WCS)
         ;; and then converted to the current UCS and checked to see if
         ;; it is equal to (0,0,1).

         ;; Incase the 210 is default and not in the dxf list.
         (if (= (assoc 210 (entget ename)) nil)
            (ddpline)
            (progn
                  (if (and (zerop (logand 120 (cdr (assoc 70 (entget ename)))))
                        (not (equal '(0.0 0.0 1.0)
                                 (trans (mapcar '+
                                          (cdr (assoc 210 (entget ename)))
                                          (trans '(0.0 0.0 0.0) 1 0)
                                       )
                                 0 1
                                 )
                                 0.0000000001          ; fuzz
                              )
                        )
                     )
                  (princ "\nThe 2D Polyline is not parallel to the current UCS.")
                  (ddpline)
                  )
            )
         )
         )

         ((= etype "SHAPE")
         (setq help_entry  "modify_Shape_dialog")
         (ddshape)
         )
         ((= etype "SOLID")
         (setq help_entry  "modify_Solid_dialog")
         (ddsolid)
         )
         ((= etype "TEXT")
         (setq help_entry  "modify_Text_dialog")
         (ddtext)
         )
         ((= etype "MTEXT")
         (setq help_entry  "modify_MText_dialog")
         (ddmtext)
         )
         ((= etype "TRACE")
         (setq help_entry  "modify_Trace_dialog")
         (ddsolid)
         )
         ((= etype "VIEWPORT")
         (setq help_entry  "modify_Viewport_dialog")
         (ddvport)
         )
         ((= etype "IMAGE")
         (setq help_entry  "modify_Image_dialog")
         (ddimage)
         )
         ((= etype "3DFACE")
         (setq help_entry  "modify_3D_Face_dialog")
         (dd3dface)
         )
         ((= etype "DIMENSION")
         (setq help_entry  "modify_Dimension_dialog")
         (ddimen)
         )
         ((= etype "TOLERANCE")
         (setq help_entry  "modify_Tolerance_dialog")
         (ddtolerance)
         )
;; Fall-through condition changed by MCAD for MDT 1.1 release.
;; This allows DDMODIFY to work on any custom object or any new object type
;; that isn't specifically handled above by calling the more generic DDCHPROP.
         (t
         (if (and (not ddchprop) (not (load "ddchprop" nil)))
            (princ (strcat "No dialog support for object type: " etype ".")))
         (progn
            (setq tempss (ssadd ename))
            (ddchprop tempss)
            (setq tempss nil)
         )
         )
      )
;; Previous fall-through condition.
;;          (t (princ (strcat "No dialog support for object type: "
;;                            etype "."
;;                   )
;;             )
;;          )
;;       )
      (ai_undo_pop)
   )
  )

  (if (eq new_pickstyle (getvar "PICKSTYLE")) ; if user didn't change pickstyle
   (setvar "PICKSTYLE" old_pickstyle)    ; transparently then set it back
  )                                        ; to what we started with

  (setq *error* old_error)
  (setvar "cmdecho" old_cmd)
  (if (not reset_flag)          ; if object was modified, then
   (ai_return ename)          ; return it's ename to caller
  )
)

(defun checkForLockedLayer (ename)
(setq layername (cdr (assoc 8 (cdr (entget ename)))))
(setq layerflag (cdr (assoc 70 (tblsearch "LAYER" layername))))
(if (= layerflag 4)
      T
      nil
)
)

(princ "  DDMODIFY loaded.  ")
(princ)
;;;???;;;---------------------------------------------------------------------------------------

; Next available MSG number is 8
; MODULE_ID DDUCSP_LSP_
;;;
;;; dducsp.lsp
;;;
;;; Copyright 1992, 1994, 1996 by Autodesk, Inc.
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and
;;; that both that copyright notice and the limited warranty and
;;; restricted rights notice below appear in all supporting
;;; documentation.
;;;
;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;; UNINTERRUPTED OR ERROR FREE.
;;;
;;; Use, duplication, or disclosure by the U.S. Government is subject to
;;; restrictions set forth in FAR 52.227-19 (Commercial Computer
;;; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;; (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;.
;;; C:DDUCSP - User Coordinate System presets dialogue.
;;;
;;;             Uses DDUCSP.DCL for the dialogue definition.  The
;;;             slide images are in ACAD.SLB.
;;;
;;; ===========================================================================
;;; ===================== load-time error checking ============================
;;;

  (defun ai_abort (app msg)
   (defun *error* (s)
      (if old_error (setq *error* old_error))
      (princ)
   )
   (if msg
   (alert (strcat " Application error: "
                  app
                  " \n\n  "
                  msg
                  "  \n"
            )
   )
   )
   (exit)
  )

;;; Check to see if AI_UTILS is loaded, If not, try to find it,
;;; and then try to load it.
;;;
;;; If it can't be found or it can't be loaded, then abort the
;;; loading of this file immediately, preserving the (autoload)
;;; stub function.

  (cond
   (  (and ai_dcl (listp ai_dcl)))       ; it's already loaded.

   (  (not (findfile "ai_utils.lsp"))                   ; find it
      (ai_abort "DDUCSP"
               (strcat "Can't locate file AI_UTILS.LSP."
                        "\n Check support directory.")))

   (  (eq "failed" (load "ai_utils" "failed"))          ; load it
      (ai_abort "DDUCSP" "Can't load file AI_UTILS.LSP"))
  )

  (if (not (ai_acadapp))             ; defined in AI_UTILS.LSP
   (ai_abort "DDUCSP" nil)       ; a Nil <msg> supresses
  )                                  ; ai_abort's alert box dialog.

;;; ==================== end load-time operations ===========================

(defun ai_ucsp_start ( / program)
  ;; Get program name
  (if (not (setq program (getvar "program")))
   (setq program "acad")
  )
  (foreach v0 '("world" "left" "cview" "top" "front"
            "bottom" "back" "right" "prev")
(start_image (strcat "ucsp_" v0))
(slide_image
   0 0
   (- (dimx_tile (strcat "ucsp_" v0)) 1) (- (dimy_tile (strcat "ucsp_" v0)) 1)
   (strcat program "(u-" v0 ")")
)
(end_image)
  )
)

(defun ai_ucsp_set ()
  (if ai_ucsp_sv
(command "_.UCS" "_V")
(if ai_ucsp_prevs
   (command "_.UCS" "_P")
   (if ai_ucsp_chg
      (progn
      (if (/= ai_ucsp_a "*")
         (setvar "LASTPOINT" (trans (getvar "UCSORG") 0 1))
      )
      (if (< ai_ucsp_pick 6)
         (setq ai_ucsp_set0 "@")
         (setq ai_ucsp_set0 "*0,0,0" ai_ucsp_a "*")
      )
      (cond ((= ai_ucsp_pick 0)
               (setq ai_ucsp_set1 "0,-1,0"
                     ai_ucsp_set2 "0,0,1"
               )
            )
            ((= ai_ucsp_pick 2)
               (setq ai_ucsp_set1 "1,0,0"
                     ai_ucsp_set2 "0,0,1"
               )
            )
            ((= ai_ucsp_pick 3)
               (setq ai_ucsp_set1 "1,0,0"
                     ai_ucsp_set2 "0,-1,0"
               )
            )
            ((= ai_ucsp_pick 4)
               (setq ai_ucsp_set1 "-1,0,0"
                     ai_ucsp_set2 "0,0,1"
               )
            )
            ((= ai_ucsp_pick 5)
               (setq ai_ucsp_set1 "0,1,0"
                     ai_ucsp_set2 "0,0,1"
               )
            )
            (T
               (setq ai_ucsp_set1 "1,0,0"
                     ai_ucsp_set2 "0,1,0"
               )
            )
      )
      (command "_.UCS" "_3P" ai_ucsp_set0
               (strcat ai_ucsp_a ai_ucsp_set1)
               (strcat ai_ucsp_a ai_ucsp_set2)
      )
      )
   )
)
  )
)

(defun ai_ucsp_p (val currtile)
  (mode_tile ai_ucsp_currtile 4)
  (setq ai_ucsp_pick val
      ai_ucsp_sv nil
      ai_ucsp_currtile currtile
  )
  (if (/= val 1)
(setq ai_ucsp_chg T)
  )
  (mode_tile ai_ucsp_currtile 4)
)

(defun ai_ucsp_swcs ()
  (mode_tile ai_ucsp_currtile 4)
  (set_tile "ucsp_a_wcs" "1")
  (setq ai_ucsp_pick 6
      ai_ucsp_sv nil
      ai_ucsp_currtile "ucsp_world"
  )
  (if (/= 1 (getvar "WORLDUCS"))
(setq ai_ucsp_chg T)
(setq ai_ucsp_chg nil)
  )
  (mode_tile ai_ucsp_currtile 4)
)

(defun ai_ucsp_cview ()
  (mode_tile ai_ucsp_currtile 4)
  (setq ai_ucsp_sv T
      ai_ucsp_chg nil
      ai_ucsp_currtile "ucsp_cview"
  )
  (set_tile "ucsp_a_wcs" "1")
  (mode_tile ai_ucsp_currtile 4)
)

(defun ai_ucsp_rucs (typ)
  (setq ai_ucsp_a typ)
  (mode_tile ai_ucsp_currtile 2)
)

(defun ai_ucsp_prev ()
  (mode_tile ai_ucsp_currtile 4)
  (setq ai_ucsp_prevs T
      ai_ucsp_currtile "ucsp_prev"
  )
  (mode_tile ai_ucsp_currtile 4)
)

(defun ai_ucsp_main ( / ai_ucsp_pick ai_ucsp_sv globals)
  (if (not (new_dialog "dducsp" dcl_id))
(exit)
  )

  (ai_ucsp_start)
  (setq ai_ucsp_a "@"
      ai_ucsp_pick 2
      ai_ucsp_currtile "ucsp_top"
  )
  (if (= 1 (getvar "WORLDUCS"))
(progn
   (set_tile "ucsp_a_wcs" "1")
   (setq ai_ucsp_currtile "ucsp_world")
)
(set_tile "ucsp_r_ucs" "1")
  )
  (mode_tile ai_ucsp_currtile 2)
  (mode_tile ai_ucsp_currtile 4)
  (action_tile "ucsp_world" "(ai_ucsp_swcs)")
  (action_tile "ucsp_cview" "(ai_ucsp_cview)")
  (action_tile "ucsp_left" "(ai_ucsp_p 0 $key)")
  (action_tile "ucsp_top" "(ai_ucsp_p 1 $key)")
  (action_tile "ucsp_front" "(ai_ucsp_p 2 $key)")
  (action_tile "ucsp_bottom" "(ai_ucsp_p 3 $key)")
  (action_tile "ucsp_back" "(ai_ucsp_p 4 $key)")
  (action_tile "ucsp_right" "(ai_ucsp_p 5 $key)")
  (action_tile "ucsp_prev" "(ai_ucsp_prev)")
  (action_tile "ucsp_r_ucs" "(ai_ucsp_rucs \"@\")")
  (action_tile "ucsp_a_wcs" "(ai_ucsp_rucs \"*\")")
  (action_tile "accept" "(done_dialog 1)")
  (action_tile "cancel" "(done_dialog 0)")
  (action_tile "help" "(help \"\" \"DDUCSP\")")
  (if (= (start_dialog) 1)
(ai_ucsp_set)
  )
)

(defun c:UUS ( / app dcl_id old_cmd old_osmode ai_ucsp_prevs
                  ai_ucsp_sw undo_init)

  ;; Set up error function.
  (setq old_cmd (getvar "CMDECHO") ; save current setting of cmdecho
      old_error  *error*          ; save current error function
      *error* ai_error             ; new error function
      old_osmode (getvar "OSMODE")  ; disable OSNAP for duration
  )

  (setvar "CMDECHO" 0)

  (cond
   (  (not (ai_notrans)))                   ; transparent not OK
   (  (not (ai_acadapp)))                   ; ACADAPP.EXP xloaded?
   (  (not (setq dcl_id (ai_dcl "dducsp"))))  ; is .DCL file loaded?
   (T (ai_undo_push)
      (setvar "OSMODE" 0)
      (ai_ucsp_main)
      (setvar "OSMODE" old_osmode)
      (ai_undo_pop)
   )
  )

  (setq *error* old_error)
  (setvar "cmdecho" old_cmd)

  (princ)
)

(princ "  DDUCSP loaded.  ")
(princ)

;;;???;;;---------------------------------------------------------------------------------------

;;;----------------------------------------------------------------------------
;;;
;;; EXCHPROP.LSP
;;; Polyline and text modification capabilities added by
;;; Randy Kintzley
;;;
;;; Copyright (C) 1997 by Autodesk, Inc.
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and
;;; that both that copyright notice and the limited warranty and
;;; restricted rights notice below appear in all supporting
;;; documentation.
;;;
;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;; UNINTERRUPTED OR ERROR FREE.
;;;
;;; Use, duplication, or disclosure by the U.S. Government is subject to
;;; restrictions set forth in FAR 52.227-19 (Commercial Computer
;;; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;; (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;.
;;; 28 February 1997
;;;
;;;
;;;----------------------------------------------------------------------------
;;; DESCRIPTION
;;;----------------------------------------------------------------------------
;;; C:EXCHPROP is an extended or enhanced version of ddchprop. This
;;; command gives the user the abilitie to change several characteristics
;;; of selected polyline and text objects.
;;;    The style and height of selectected text objects can be modified
;;; (including text, mtext and attribute definitions) as well as, width and
;;; elevation characteristics of selected polylines (includes lightweight and
;;; traditional polylines.)
;;;----------------------------------------------------------------------------
;;;----------------------------------------------------------------------------
;;; Prefixes in command and keyword strings:
;;;    "."  specifies the built-in AutoCAD command in case it has been
;;;          redefined.
;;;    "_"  denotes an AutoCAD command or keyword in the native language
;;;          version, English.
;;;----------------------------------------------------------------------------
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;GLOBAL INFO.;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Functions created as result of loading file: exchprop.lsp
; DDCHPROP2
; DDCHPROP2_INIT
; DDCHPROP2_SELECT
;
;Variables created as result of loading file: exchprop.lsp
; OLD_ALLOC
;
;Functions created as a result of executing the commands in: exchprop.lsp
;
;Variables created as a result of executing the commands in: exchprop.lsp
; AI_SELTYPE
; BONUS_ALIVE
; BONUS_OLD_ERROR
;;;;;;;;;;;;;;;;;;;;;;;;;;;;GLOBAL INFO.;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;
;;; Avoid (gc)s on load to improve load time.
;;;
(defun do_alloc (/ old_allod new_alloc)
  (setq old_alloc (alloc 2000) new_alloc (alloc 2000))
  (expand (1+ (/ 4750 new_alloc)))
  (alloc old_alloc)
);defun

;runs at load time - rk
(do_alloc)
(setq do_alloc nil)
;;;
;;; ===========================================================================
;;; ===================== load-time error checking ============================
;;;

  (defun ai_abort (app msg)
   (defun *error* (s)
   (if old_error (setq *error* old_error))
   (princ)
   );defun
   (if msg
   (alert (strcat " Application error: "
                  app
                  " \n\n  "
                  msg
                  "  \n"
            )
   );alert
   );if
   ;(*error* msg)
   (exit)
  );defun ai_abort

;runs at load time - rk
;(if (and *error*    ;added the if wrapper around this - rk.
;       (not old_error)
; );and
; (setq old_error *error*);setq
;);if

;;; Check to see if AI_UTILS is loaded, If not, try to find it,
;;; and then try to load it.
;;;
;;; If it can't be found or it can't be loaded, then abort the
;;; loading of this file immediately, preserving the (autoload)
;;; stub function.

;runs at load time - rk.
(cond
(  (and ai_dcl (listp ai_dcl)))       ; it's already loaded.
(  (not (findfile "ai_utils.lsp"))                   ; find it
(ai_abort "EXCHPROP"
            (strcat "Can't locate file AI_UTILS.LSP."
                  "\n Check support directory.")
);ai_abort
)
(  (eq "failed" (load "ai_utils" "failed"))          ; load it
(ai_abort "EXCHPROP" "Can't load file AI_UTILS.LSP")
)
);cond close

(if (not (ai_acadapp))             ; defined in AI_UTILS.LSP
(ai_abort "EXCHPROP" nil)    ; a Nil <msg> supresses
);if                               ; ai_abort's alert box dialog.

;;; ==================== end load-time operations ===========================

;;; Initialize program subroutines and variables.

(defun ddchprop2_init()

  ;;
  ;; Define buttons and set values in CHPROP dialogue box
  ;;
  (defun call_chp2 (/ cmdact p1 p2)

(if (not (new_dialog "ch_prop" dcl_id))
      (exit)
)

(set_tile "error" "")
;; Set initial dialogue tile values
(set_col_tile)
(set_tile "t_layer" elayer)

(cond
   ((= lt-idx nil)
      (set_tile "t_ltype" "Varies")
   )
   ((= lt-idx 0) ; set tile "By layer & layer linetype"
      (set_tile "t_ltype" (bylayer_lt))
   )
   (T
      (set_tile "t_ltype" (nth lt-idx ltnmlst))
   )
)

(if (or (= ethickness nil)
         (= ethickness "")
         (= ethickness "Varies")
      );or
      (set_tile "eb_thickness" "")
      (set_tile "eb_thickness" (ai_rtos ethickness))
);if
(if (or (= eltscale nil)
         (= eltscale "")
         (= eltscale "Varies")

      )
      (set_tile "eb_ltscale" "")
      (set_tile "eb_ltscale" (ai_rtos eltscale))
)
(if
   (numberp ewidth)
   (set_tile "poly_wid" (ai_rtos ewidth))
   (set_tile "poly_wid" ewidth)
)
(if
   (numberp eelevation)
   (set_tile "poly_elev" (ai_rtos eelevation))
   (set_tile "poly_elev" eelevation)
)
(if
   (numberp eheight)
   (set_tile "text_hgt" (ai_rtos eheight))
   (set_tile "text_hgt" eheight)
)
(if (not estyle)
      (setq estyle "")
);if
(setq hair_style_list (tnlist '("style" 16)));setq
(if (not (member estyle hair_style_list))
      (setq hair_style_list (append hair_style_list (list estyle)));setq
);if

(setq hair_style_list (acad_strlsort hair_style_list));setq
(mpoplst "text_style" hair_style_list)
(set_tile "text_style"
            (itoa (position estyle hair_style_list))
);set_tile

;; Disable tiles if need be...  ;@RK
(setq a 0)
(while ( < a  (sslength ss))
   (setq which_tiles
         (ai_common_state (cdr (assoc '0 (entget (ssname ss a))))))

   ;; If all fields are enabled, don't bother checking anymore.
   (if (/= which_tiles (logior 1 2 4 8 16))
      (setq a (1+ a))
      (setq a (sslength ss))
   )
)
;; Layer Button and Text Field

(if (/= 1 (logand 1 which_tiles))
   (progn
      (mode_tile "t_layer" 1)
      (mode_tile "b_name" 1)
   )
)

;; Color Button and Text Field
(if (/= 2 (logand 2 which_tiles))
   (progn
      (mode_tile "t_color" 1)
      (mode_tile "b_color" 1)
      (mode_tile "show_image" 1)
   )
)
;; Linetype Button and Text Field
(if (/= 4 (logand 4 which_tiles))
   (progn
      (mode_tile "t_ltype" 1)
      (mode_tile "b_line" 1)
   )
)
;; Linetype Scale Edit Field
(if (/= 8 (logand 8 which_tiles))
   (progn
      (mode_tile "eb_ltscale" 1)
   )
)
;; Thickness Edit Field.
(if (/= 16 (logand 16 which_tiles))
   (progn
      (mode_tile "eb_thickness" 1)
   )
)

;; Polyline box and tiles       @rk 10:05 AM 1/30/97
(if (not (= 2 (logand 2 eflag)))
      (progn
      (mode_tile "text_hgt" 1)
      (mode_tile "text_style" 1)
      );progn
);if
(if (not (= 1 (logand 1 eflag)))
      (progn
      (mode_tile "poly_wid" 1)
      (mode_tile "poly_elev" 1)
      );progn then disable polyline fields
);if

;; Define action for tiles
(action_tile "b_color" "(setq ecolor (getcolor))")
(action_tile "show_image" "(setq ecolor (getcolor))")
(action_tile "b_name" "(setq elayer (getlayer))")
(action_tile "b_line" "(setq eltype (getltype))")
(action_tile "eb_ltscale"  "(getscale $value)")
(action_tile "eb_thickness"  "(getthickness $value)")
(action_tile "poly_wid" "(getwidth $value)")
(action_tile "poly_elev" "(getelevation $value)")
(action_tile "text_hgt" "(getheight $value)")
(action_tile "text_style" "(getstyle $value hair_style_list)")
(action_tile "help" "(help \"AC_BONUS.HLP\" \"EXCHPROP\")")
(action_tile "accept" "(test-main-ok)")

(if (= (start_dialog) 1)
   (progn
      ; Update special properties for polyline and text selection-sets.

      (if (and (= 1 (logand 1 eflag)) ; polylines rk chprop
               (or ewidth
                  eelevation
               );or
         );and
         (progn
         (setq  ss-index 0
               ss-length (sslength poly_ss)
         );setq
         (while (< ss-index ss-length)
            (setq ename (ssname poly_ss ss-index)
                  elist (entget ename)
            );setq
            (ucs_2_ent (cdr (assoc 210 elist)));this function lives in ac_bonus.lsp
            (if ewidth
               (command "_.pedit" ename "_W" ewidth "_x")
            );if
            (if eelevation
               (progn
                  (setq p2 (list 0.0 0.0 eelevation));setq
                  (if (equal (cdr (assoc 0 elist)) "POLYLINE")
                     (setq p1 (list 0.0 0.0
                                    (caddr (cdr (assoc 10 elist)))
                              );list
                     );setq
                     (progn
                     (if (assoc 38 elist)
                           (setq p1 (list 0.0 0.0
                                          (cdr (assoc 38 elist))
                                    );list
                           );setq
                           (setq p1 '(0.0 0.0 0.0))
                     );if
                     );progn
                  );if
                  (command "_.move" ename "" p1 p2)
               );progn then change the elevation of the polyline
            );if
            (command "_.ucs" "_p")
            (setq ss-index (1+ ss-index))
         );while
         );progn then polylines are in the selset
      );if
      (if (and (= 2 (logand 2 eflag))    ; text
               (or eheight
                  estyle
               );or
         );and
         (progn
            (setq ss-index 0 ss-length (sslength txt_ss))
            (while
            (< ss-index ss-length)
            (setq elist (entget (setq ename (ssname txt_ss ss-index))))
            (if (numberp eheight)
                  (setq elist (subst (cons 40 eheight)
                                    (assoc 40 elist)
                                    elist
                              );subst
                  );setq
            );if
            (if (and estyle ;(not (equal estyle ""))
                     (not (equal estyle (cdr (assoc 7 elist))))
                  );and
                  (progn
                  ;rk. This needs to be implemented as per mtext font issue in                                                                                                       ; ddchprop_notes.txt
                  ;(if (equal "MTEXT" (cdr (assoc 0 elist)))
                  ; (setq elist (fix_mtext_fonts estyle
                  ;                               elist
                  ;             )
                  ; );setq then
                     (setq elist (subst (cons 7 estyle)
                                          (assoc 7 elist)
                                          elist
                                    );subst
                     );setq else
                  ;);if
                  );progn
            );if
            (entmod elist)
            (setq ss-index (1+ ss-index))
            );while
         );progn then
      );if

      (setq cmdact (getvar "cmdactive"))
      (command "_.chprop" ss "")
      (if (/= cmdact (getvar "cmdactive"))  ; Is CHPROP actually running?
      (progn
         (if ecolor
            (progn
               (if (= 0 ecolor) (setq ecolor ;|MSG0|;"BYBLOCK"))
               (if (= 256 ecolor) (setq ecolor ;|MSG0|;"BYLAYER"))
               (command "_c" ecolor)
            );progn then
         )
         (if (and lt-idx
                  (/= eltype ;|MSG0|;"Varies")
            )
            (command "_lt" eltype)
         )
         (if (and lay-idx
                  (/= elayer ;|MSG0|;"Varies")
            )
            (command "_la" elayer)
         )
         (if (and ethickness
                  (/= ethickness "")
                  (/= ethickness "Varies")
            )
            (command "_t" ethickness)
         )
         (if (and  eltscale (/= eltscale ""))
            (command "_lts" eltscale)
         );if
         (command "")
      )
      (princ "\nProperties unchanged")  ; CHPROP didn't like our SS set
      )

   );progn then OK was picked in the dialog.

   ;; Fred GERBER - 25-AUG-94
   ;; Don't print the "Properties unchanged" message when the user cancels
   ;; the dialog because he knows that already (otherwise he would have
   ;; hit the "OK" button). Display the message only if CHPROP fails for
   ;; some reason, because it is not the expected behavior of the command.
   ;;
   ;; (princ ;|DDCHPROP2_LSP_8|;"\nProperties unchanged")
);if
(princ)
  );defun call_chp2
  ;;
  ;; Function to set the Color text tile and swab to the current color value.
  ;;
  (defun set_col_tile()
(cond
   ((= ecolor nil)
      (set_tile "t_color" "Varies")
      (col_tile "show_image" 0 nil)
   )
   ((= ecolor 0)
      (set_tile "t_color" "BYBLOCK")
      (col_tile "show_image" 7 nil) ; show BYBLOCK as white
   )
   ((= ecolor 1)
      (set_tile "t_color" "1 red")
      (col_tile "show_image" 1 nil)
   )
   ((= ecolor 2)
      (set_tile "t_color" "2 yellow")
      (col_tile "show_image" 2 nil)
   )
   ((= ecolor 3)
      (set_tile "t_color" "3 green")
      (col_tile "show_image" 3 nil)
   )
   ((= ecolor 4)
      (set_tile "t_color" "4 cyan")
      (col_tile "show_image" 4 nil)
   )
   ((= ecolor 5)
      (set_tile "t_color" "5 blue")
      (col_tile "show_image" 5 nil)
   )
   ((= ecolor 6)
      (set_tile "t_color" "6 magenta")
      (col_tile "show_image" 6 nil)
   )
   ((= ecolor 7)
      (set_tile "t_color" "7 white")
      (col_tile "show_image" 7 nil)
   )
   ;; If the color is "BYLAYER", then set the tile to
   ;; show it's set By layer, but also indicate the
   ;; color of the layer - i.e. By layer (red)
   ((= ecolor 256)
      (set_tile "t_color" (bylayer_col))
      (col_tile "show_image" cn nil)
   )
   (T
      (set_tile "t_color" (itoa ecolor))
      (col_tile "show_image" ecolor nil)
   )
)
  )
  ;;
  ;;  Function to put up the standard color dialogue.
  ;;
  (defun getcolor(/ col_def lay_clr temp_color)
;; col_def is the default color used when rq_color is called.  If ecolor
;; is nil (varies) then set it to 1, else use the value of ecolor.
(if ecolor
   (setq col_def ecolor)
   (setq col_def 1)
)

;; If we're working with a single layer, get its color
;; for use in the color swatch if the user selects color BYLAYER.
(if (/= elayer ;|MSG0|;"Varies")
   (setq lay_clr (cdr (assoc 62 (tblsearch "layer" elayer))))
   (setq lay_clr 0)
)
(if (numberp (setq temp_color (acad_colordlg col_def T lay_clr)))
   (progn
      (setq ecolor temp_color)
      (set_col_tile)
      ecolor
   )
   ecolor
)
  )
  ;;
  ;; This function pops a dialogue box consisting of a list box, image tile,
  ;; and edit box to allow the user to select or type a linetype.  It returns
  ;; the linetype selected.
  ;;
  (defun getltype (/ old-idx ltname)
;; Initialize a dialogue from dialogue file
(if (not (new_dialog "setltype" dcl_id)) (exit))
(start_list "list_lt")
(mapcar 'add_list ltnmlst)       ; initialize list box
(end_list)
(setq old-idx lt-idx)
;; Show initial ltype in image tile, list box, and edit box
(if (/= lt-idx nil)
      (ltlist_act (itoa lt-idx))
      (progn
      (set_tile "edit_lt" "")
      (col_tile "show_image" 0 nil)
      );progn else
);if
(action_tile "list_lt" "(ltlist_act $value)")
(action_tile "edit_lt" "(ltedit_act)")
(action_tile "accept" "(test-ok)")
(action_tile "cancel" "(reset-lt)")
(if (= (start_dialog) 1)          ; User pressed OK
      (cond
      ((or (= lt-idx nil)
            (= lt-idx (1- (length ltnmlst)))
      );or
      (set_tile "t_ltype" "Varies")
      ;|MSG0|;"Varies"
      )
      ((= lt-idx 0)
      (set_tile "t_ltype" (bylayer_lt))
         ;|MSG0|;"BYLAYER"
      )
      ((= lt-idx 1)
         (set_tile "t_ltype" "BYBLOCK")
         ;|MSG0|;"BYBLOCK"
      )
      (T
         (set_tile "t_ltype" ltname)
         ltname
      )
      );cond then
      eltype
);if
  );defun
  ;;
  ;; Edit box entries end up here
  ;;
  (defun ltedit_act ( / flag)
;; If linetype name,is valid, then clear error string,
;; call ltlist_act function, and change focus to list box.
;; Else print error message.

(setq ltvalue (xstrcase (get_tile "edit_lt")))
(if (or (= ltvalue ;|MSG0|;"BYLAYER")
         (= ltvalue "BY LAYER")
      )
      (setq ltvalue "BYLAYER")
)
(if (or (= ltvalue ;|MSG0|;"BYBLOCK")
         (= ltvalue "BY BLOCK")
      )
      (setq ltvalue "BYBLOCK")
)
(if (setq lt-idx (getindex ltvalue ltnmlst))
      (progn
      (set_tile "error" "")
      (ltlist_act (itoa lt-idx))
      ;(mode_tile "list_lt" 2)
      );progn then
      (progn
      (if (/= ltvalue "")
         (progn
            (set_tile "error" "Invalid linetype.")
            (setq flag T)
         );progn
      )
      (setq lt-idx old-idx)
      );progn else
);if
(if (and (not flag) ;added so a return will take you out of the dialog.
         (= $reason 1)
      );and
      (done_dialog 1)
);if
  );defun ltedit_act
  ;;
  ;; List selections end up here
  ;;
  (defun ltlist_act (index / dashdata)
;; Update the list box, edit box, and color tile
(set_tile "error" "")
(setq lt-idx (atoi index))
(setq ltname (nth lt-idx ltnmlst))
(setq dashdata (nth lt-idx mdashlist))
(col_tile "show_image" 0 dashdata)
(set_tile "list_lt" (itoa lt-idx))
(set_tile "edit_lt" ltname)
  )
  ;;
  ;; Reset to original linetype when cancel it selected
  ;;
  (defun reset-lt ()
(setq lt-idx old-idx)
(done_dialog 0)
  )
  ;;
  ;; This function pops a dialogue box consisting of a list box and edit box to
  ;; allow the user to select or type a layer name.  It returns the layer name
  ;; selected.  It also the status (On, Off, Frozen, etc.) of all layer in the
  ;; drawing.
  ;;
  (defun getlayer (/ old-idx layname on off frozth linetype colname)
;; Create layer list the first time the layer
;; dialogue is called.
(if (not lay-idx)
      (progn
      (makelaylists)                   ; layer list - laynmlst
      ;rk
      (setq lay-idx (getindex elayer laynmlst))
      );progn
);if

;; Load a dialogue from dialogue file
(if (not (new_dialog "setlayer" dcl_id)) (exit))
(start_list "list_lay")
(mapcar 'add_list longlist)       ; initialize list box
(end_list)
;; Display current layer, show initial layer name in edit
;; box, and highlight list box.
(setq old-idx lay-idx)
(if (/= lay-idx nil) (laylist_act (itoa lay-idx)))
(set_tile "cur_layer" (getvar "clayer"))
(action_tile "list_lay" "(laylist_act $value)")
(action_tile "edit_lay" "(layedit_act)")
(action_tile "accept" "(test-ok)")
(action_tile "cancel" "(reset-lay)")
(if (= (start_dialog) 1)          ; User pressed OK
   (progn
      (if (or (= lay-idx nil)
               (= lay-idx (1- (length laynmlst)))
         );or
         (progn
            (setq lay-idx nil)
            (setq layname ;|MSG0|;"VARIES")
            (set_tile "t_layer" "Varies")
            (setq layname "")
         );progn
         (set_tile "t_layer" layname)
      );if
      ; If layer or ltype equals bylayer reset their tiles
      (if (= lt-idx 0)
         (set_tile "t_ltype" (bylayer_lt))
      );if
      (if (= ecolor 256)
         (progn
            (set_tile "t_color" (bylayer_col))
            (col_tile "show_image" cn nil)
         )
      );if
      layname
   );progn
   elayer
);if
  )
  ;;
  ;; Edit box selections end up here
  ;;
  (defun layedit_act()
;; Convert layer entry to upper case.  If layer name is
;; valid, clear error string, call (laylist_act) function,
;; and change focus to list box.  Else print error message.
(setq layvalue (xstrcase (get_tile "edit_lay")))
(if (setq lay-idx (getindex layvalue laynmlst))
      (progn
      (set_tile "error" "")
      (laylist_act (itoa lay-idx))
      )
      (progn
      (set_tile "error" "Invalid layer name.")
      (mode_tile "edit_lay" 2)
      (setq lay-idx old-idx)
      )
);if
  );defun
  ;;
  ;; List entry selections end up here
  ;;
  (defun laylist_act (index / layinfo color dashdata)
;; Update the list box, edit box, and color tile
(set_tile "error" "")
(setq lay-idx (atoi index))
(if (not (equal lay-idx (1- (length laynmlst))))
      (progn
      (setq layname (nth lay-idx laynmlst))
      (setq layinfo (tblsearch "layer" layname))
      (setq color (cdr (assoc 62 layinfo)))
      (setq color (abs color))
      (setq colname (colorname color))
      (set_tile "list_lay" (itoa lay-idx))
      (set_tile "edit_lay" layname)
      ;(mode_tile "list_lay" 2)
      );progn then
      (set_tile "edit_lay" "")
);if
  );defun laylist_act
  ;;
  ;; Reset to original layer when cancel is selected
  ;;
  (defun reset-lay ()
(setq lay-idx old-idx)
(done_dialog 0)
  )

  ;; Checks validity of linetype scale from edit box.  It checks to
  ;; see if the value equals "Varies".

  (defun getscale (value / rval)
(setq value (strcase value)
         rval (distof value)
);setq
(if (or (= value "")
         (> rval 0.0)
      )
      (progn
      (set_tile "error" "")
      (if (= value "")
            (progn
            (set_tile "eb_ltscale" "")
            (setq eltscale nil)
            );progn then
            (progn
            (setq eltscale (distof value))
            (set_tile "eb_ltscale" (ai_rtos eltscale))
            eltscale
            );progn else
      );if
      );progn
      (progn
      (set_tile "error" "Invalid ltscale.")
      nil
      );progn else
);if
  );defun
  ;;
  ;; Checks validity of thickness from edit box. Since (atof) returns 0 when a
  ;; string can't be converted to a real, this routine checks if the first
  ;; character is "0".  It also checks to see if the value equals "Varies".
  ;;
  (defun getthickness (value)
(setq value (strcase value))
(if (or (= value "")
         (distof value)
      );or
      (progn
      (set_tile "error" "")
      (if (= value "")
         (progn
            (set_tile "eb_thickness" "")
            (setq ethickness nil)
         );progn
         (progn
            (setq ethickness (distof value))
            (set_tile "eb_thickness" (ai_rtos ethickness))
            ethickness
         );progn
      );if
      );progn
      (progn
      (set_tile "error" "Invalid thickness.")
      nil
      );progn
);if
  );defun
  ;;
  ;; Checks validity of polyline elevation from edit box.
  ;;
  (defun getelevation (value)
(setq value (strcase value))
(if (or (= value "")
         (distof value)
      )
      (progn
      (set_tile "error" "")
      (if (= value "")
         (progn
            (set_tile "poly_elev" "")
            (setq eelevation nil)
         );progn
         (progn
            (setq eelevation (distof value))
            (set_tile "poly_elev" (ai_rtos eelevation))
            eelevation
         );progn
      );if
      );progn
      (progn
      (set_tile "error" "Invalid elevation.")
      nil
      );progn
);if
  );defun
  ;;
  ;; Checks validity of polyline width from edit box.
  ;;
  (defun getwidth (value / rval)
(setq value (strcase value)
         rval (distof value)
)
(if (or (= value "")
         (>= rval 0.0)
      )
      (progn
      (set_tile "error" "")
      (if (= value "")
         (progn
            (set_tile "poly_wid" "")
            (setq ewidth nil)
         );progn
         (progn
            (setq ewidth (distof value))
            (set_tile "poly_wid" (ai_rtos ewidth))
            ;width
         );progn
      );if
      );progn
      (progn
      (set_tile "error" "Invalid width.")
      ;(setq ewidth nil)
      nil
      );progn
);if
  );defun
  ;;
  ;; Checks validity of text height from edit box.
  ;;
  (defun getheight (value / rval)
(setq value (strcase value)
         rval (distof value)
)
(if (or (= value "")
         (> rval 0.0)
      )
      (progn
      (set_tile "error" "")
      (if (= value "")
         (progn
            (set_tile "text_hgt" "")
            (setq eheight nil)
         );progn
         (progn
            (setq eheight (distof value))
            (set_tile "text_hgt" (ai_rtos eheight))
            eheight
         );progn
      );if
      );progn
      (progn
      (set_tile "error" "Invalid height.")
      nil
      );progn
);if
  );defun

  (defun getstyle (value lst / rval)
;(setq value (strcase value))
(set_tile "error" "")
(setq estyle (nth (atoi value) lst))
(if (equal estyle "")
      (setq estyle nil)
);if

  );defun getstyle

  ;;
  ;; This function make a list called laynmlst which consists of all the layer
  ;; names in the drawing.  It also creates a list called longlist which
  ;; consists of strings which contain the layer name, color, linetype, etc.
  ;; Longlist is later mapped into the layer listbox.  Both are ordered the
  ;; same.
  ;;
  (defun makelaylists (/ layname onoff frozth color linetype lock vpf vpn ss cvpname
                     xdlist vpldata sortlist name templist bit-70
                     layer_number
                  )
(if (= (setq tilemode (getvar "tilemode")) 0)
   (progn
      (setq ss (ssget "_x" (list (cons 0 "VIEWPORT")
                              (cons 69 (getvar "CVPORT"))
                        )
               )
      )
      (setq cvpname (ssname ss 0))
      (setq xdlist (assoc -3 (entget cvpname '("acad"))))
      (setq vpldata (cdadr xdlist))
   )
)
(setq sortlist nil)
(setq templist (tblnext "LAYER" T))
(setq layer_number 1)
(while templist
   (if (not (equal 16 (logand 16 (cdr (assoc 70 templist)))))
      (progn
         (setq name (cdr (assoc 2 templist)))
         (setq sortlist (cons name sortlist))
         ;; Not dead message...
         (setq layer_number (1+ layer_number))
      );progn
   );if
   (setq templist (tblnext "LAYER"))
   (if (= (/ layer_number 50.0) (fix (/ layer_number 50.0)))
      (set_tile "error" (strcat "Collecting..." (itoa layer_number)))
   );if
)
(set_tile "error" "")
(if (>= (getvar "maxsort") (length sortlist))
   (progn
      (if (> layer_number 50)
      (set_tile "error" "Sorting...")
      )
      (setq sortlist (acad_strlsort sortlist))
   )
   (setq sortlist (reverse sortlist))
)
(set_tile "error" "")
(setq laynmlst sortlist)
;rk
(setq laynmlst (append laynmlst (list "")))

(setq longlist nil)
(setq layname (car sortlist))
(setq layer_number 1)
(while layname
   (if (= (/ layer_number 50.0)
         (fix (/ layer_number 50.0))
      )
      (set_tile "error" (strcat "Analyzing..." (itoa layer_number)))
   );if
   (setq layer_number (1+ layer_number))
   (setq laylist (tblsearch "LAYER" layname))
   (setq color (cdr (assoc 62 laylist)))
   (if (minusp color)
      (setq onoff ".")
      (setq onoff "On")
   )
   (setq color (abs color))
   (setq colname (colorname color))
   (setq bit-70 (cdr (assoc 70 laylist)))
   (if (= (logand bit-70 1) 1)
      (setq frozth "F" fchk laylist)
      (setq frozth ".")
   )
   (if (= (logand bit-70 2) 2)
      (setq vpn "N")
      (setq vpn ".")
   )
   (if (= (logand bit-70 4) 4)
      (setq lock "L")
      (setq lock ".")
   )
   (setq linetype (cdr (assoc 6 laylist)))
   (setq layname (substr layname 1 31))
   (if (= tilemode 0)
      (progn
      (if (member (cons 1003 layname) vpldata)
         (setq vpf "C")
         (setq vpf ".")
      )
      )
      (setq vpf ".")
   )
   (setq ltabstr (strcat layname "\t"
                           onoff "\t"
                           frozth "\t"
                           lock "\t"
                              vpf "\t"
                              vpn "\t"
                        colname "\t"
                        linetype
                  )
   )
   (setq longlist (append longlist (list ltabstr)))
   (setq sortlist (cdr sortlist))
   (setq layname (car sortlist))
);while
(setq longlist (append longlist (list "")))
(set_tile "error" "")
  )
  ;;
  ;; This function makes 2 lists - ltnmlst & mdashlist.  Ltnmlst is a list of
  ;; linetype names read from the symbol table.  Mdashlist is list consisting
  ;; of lists which define the linetype pattern - numbers that indicate dots,
  ;; dashes, and spaces taken from group code 49.  The list corresponds to the
  ;; order of names in ltnmlst.
  ;;
  (defun makeltlists (/ ltlist ltname)
(setq mdashlist nil)
(setq ltlist (tblnext "LTYPE" T))
(setq ltname (cdr (assoc 2 ltlist)))
(setq ltnmlst (list ltname))
(while (setq ltlist (tblnext "LTYPE"))
   (if (not (equal 16 (logand 16 (cdr (assoc 70 ltlist)))))
      (progn
      (setq ltname (cdr (assoc 2 ltlist)))
      (setq ltnmlst (append ltnmlst (list ltname)))
      );progn
   );if
);while
(setq ltnmlst (acad_strlsort ltnmlst))
(setq ltnmlst (append ltnmlst (list "")));add by rk
(foreach ltname ltnmlst
   (setq ltlist (tblsearch "LTYPE" ltname))
   (if (= ltname "CONTINUOUS")
      (setq mdashlist (append mdashlist (list "CONT")))
      (setq mdashlist
         (append mdashlist (list (add-mdash ltlist)))
      )
   )
)
(setq ltnmlst (cons "BYBLOCK" ltnmlst))
(setq mdashlist  (cons nil mdashlist))
(setq ltnmlst (cons "BYLAYER" ltnmlst))
(setq mdashlist  (cons nil mdashlist))
  )
  ;;
  ;; Get all the group code 49 values for a linetype and put them in a list
  ;; (pen-up, pen-down info)
  ;;
  (defun add-mdash (ltlist1 / dashlist assoclist dashsize)
(setq dashlist nil)
(while (setq assoclist (car ltlist1))
   (if (= (car assoclist) 49)
      (progn
      (setq dashsize (cdr assoclist))
      (setq dashlist (cons dashsize dashlist))
      )
   )
   (setq ltlist1 (cdr ltlist1))
)
(setq dashlist (reverse dashlist))
  )
  ;;
  ;; Color a tile, draw linetype, and draw a border around it
  ;;
  (defun col_tile (tile color patlist / x y)
(setq x (dimx_tile tile))
(setq y (dimy_tile tile))
(start_image tile)
(fill_image 0 0 x y color)
(if (= color 7)
   (progn
      (if patlist (drawpattern x (/ y 2) patlist 0))
      (tile_rect 0 0 x y 0)
   )
   (progn
      (if patlist (drawpattern x (/ y 2) patlist 7))
      (tile_rect 0 0 x y 7)
   )
)
(end_image)
  )
  ;;
  ;; Draw a border around a tile
  ;;
  (defun tile_rect (x1 y1 x2 y2 color)
(setq x2 (- x2 1))
(setq y2 (- y2 1))
(vector_image x1 y1 x2 y1 color)
(vector_image x2 y1 x2 y2 color)
(vector_image x2 y2 x1 y2 color)
(vector_image x1 y2 x1 y1 color)
  )
  ;;
  ;; Draw the linetype pattern in a tile.  Boxlength is the length of the image
  ;; tile, y2 is the midpoint of the height of the image tile, pattern is a
  ;; list of numbers that define the linetype, and color is the color of the
  ;; tile.
  ;;
  (defun drawpattern (boxlength y2 pattern color / x1 x2
                  patlist dash)
(setq x1 0 x2 0)
(setq patlist pattern)
(setq fx 30)
(if (= patlist "CONT")
   (progn
      (setq dash boxlength)
      (vi)
      (setq x1 boxlength)
   )
   (foreach dash patlist
      (if (> (abs dash) 2.5)
      (setq fx 2)
      )
   )
)
(while (< x1 boxlength)
   (if (setq dash (car patlist))
      (progn
      (setq dash (fix (* fx dash)))
      (cond
         ((= dash 0)
            (setq dash 1)
            (vi)
         )
         ((> dash 0)
            (vi)
         )
         (T
            (if (< (abs dash) 2) (setq dash 2))
            (setq x2 (+ x2 (abs dash)))
         )
      )
      (setq patlist (cdr patlist))
      (setq x1 x2)
      )
      (setq patlist pattern)
   )
)
  )
  ;;
  ;; Draw a dash or dot in image tile
  ;;
  (defun vi ()
(setq x2 (+ x2 dash))
(vector_image x1 y2 x2 y2 color)
  )

  ;; This function takes a selection and returns a list of the color,
  ;; linetype, layer, linetype scale, and thickness properties that
  ;; are common to every entities in the selection set - (color
  ;; linetype layer thickness).  If all entities do not share the same
  ;; property value it returns "Varies" in place of the property
  ;; value.  i.e.  ("BYLAYER" "DASHED" "Varies" 0)
  ;; The last item in the return list is an integer flag for the
  ;; homegenity of the selection-set object types.
  ;; 1 = All polylines
  ;; 2 = All text or mtext or attdef, or a combination of the three
  ;;  -1 = Any other mix of objects

  (defun getprops (selset / sslen elist color ltype layer ltscale thickness
                        width elevation height go ctr
                        eflag
                        etype temp
                        txt_ss    ;;;;rk 11:24 AM 1/30/97
                        tmp
                        poly_ss
                        style
               )

(setq    sslen (sslength selset)
            elist (entget (ssname selset 0))
            etype (strcase (cdr (assoc 0 elist)))
            color (cdr (assoc 62 elist))
            ltype (cdr (assoc 6 elist))
            layer (cdr (assoc 8 elist))
      thickness (cdr (assoc 39 elist))
         ltscale (cdr (assoc 48 elist))
);setq

(if (not color)    (setq color 256))
(if (not ltype)    (setq ltype "BYLAYER"))
(if (not thickness) (setq thickness 0))
(if (not ltscale) (setq ltscale 1))

(if (not width)    (setq width ""))
(if (not elevation) (setq elevation ""))
(if (not height) (setq height ""))

(setq    go T
      chk-col T
         chk-lt T
      chk-lay T
      chk-lts T
         chk-th T
            ctr 0
);setq

;; Page through the selection set.  When a property
;; does not match, stop checking for that property.
;; When the selection set is not homogenous, stop checking.
;; If all properties vary and the set is not a type 1
;; (polyline) or type 2 (attdef/text/mtext) set, stop paging.

;Lets set the eflag so we know if the selection set includes any
;combination of polylines, lwpolylines, text, mtext or attdefs.

;watch out for 3dpolyline and 3dmeshes here! @rk 10:17 AM 1/30/97
(setq eflag 0)
(if (setq poly_ss
            (ssget "P" (list '(0 . "*POLYLINE")
                           '(-4 . "<AND")
                              '(-4 . "<NOT") '(-4 . "&=") '(70 . 8)  '(-4 . "NOT>")
                              '(-4 . "<NOT") '(-4 . "&=") '(70 . 16) '(-4 . "NOT>")
                              '(-4 . "<NOT") '(-4 . "&=") '(70 . 64) '(-4 . "NOT>")
                           '(-4 . "AND>")
                     );list
            );ssget get 2d polylines (legacy and lw)
      );setq
      (progn
      (setq eflag (+ eflag 1))

      (setq tmp (entget (ssname poly_ss 0)));setq

      (if (equal "POLYLINE" (cdr (assoc 0 tmp)))
         (setq elevation (last (cdr (assoc 10 tmp))))
         (setq elevation (cdr (assoc 38 tmp)))
      );if
      (if (not elevation)
         (setq elevation 0.0);setq
      );if

      (setq tmp (ssget "P"
                        (list
                           '(-4 . "<OR")
                           '(-4 . "<AND")
                              '(0 . "LWPOLYLINE")
                              (cons 38 elevation)
                           '(-4 . "AND>")
                           '(-4 . "<AND")
                              '(0 . "POLYLINE")
                              '(-4 . "*,*,=")
                              (cons 10 (list 1.0 1.0 elevation))
                           '(-4 . "AND>")
                           '(-4 . "OR>")
                     );list
               );ssget
      );setq

      (if (and tmp
               (equal (sslength tmp) (sslength poly_ss))
         );and
         (setq elevation (ai_rtos elevation));setq
         (setq elevation "")
      );if

      (setq width (pl_width_getter poly_ss));setq

      );progn then 2d polylines and/or lwpolylines are in the HHHHHOUSE!
);if
(command "_.select" selset "")

(if (setq txt_ss
            (ssget "P" '((-4 . "<OR") (0 . "TEXT") (0 . "MTEXT")
                        (0 . "ATTDEF") (-4 . "OR>"))
            )
      );setq
      (progn
      (setq eflag (+ eflag 2))
      (setq height (cdr (assoc 40 (entget (ssname txt_ss 0))))
               tmp (ssget "P" (list (cons 40 height)))
      );setq
      (if (and tmp
               (equal (sslength txt_ss) (sslength tmp))
         );and
         (setq height (ai_rtos height));setq  ;@rk need to translate from float
                                                ;to string and back again easily
         (setq height "");setq else the height varies
      );if
      (command "_.select" txt_ss "")
      (setq style (cdr (assoc 7 (entget (ssname txt_ss 0))))
               tmp (ssget "P" (list (cons 7 style)))
      );setq
      (if (not (and tmp
                     (equal (sslength txt_ss) (sslength tmp))
               );and
         );not
         (setq style "");setq then the style varies
      );if
      );progn the text type objects are in the selection set
);if
(command "_.select" selset "")

(while (and (> sslen ctr)
            go
         );and
   (setq elist (entget (setq en (ssname selset ctr))))

   (if chk-col (match-col))
   (if chk-lt (match-lt))
   (if chk-lay (match-lay))
   (if chk-lts (match-lts))
   (if chk-th (match-th))

   ;(if chk-etype (match-etype))

   (setq ctr (1+ ctr))
   (if (and (not chk-col)
            (not chk-lt)
            (not chk-lay)
            (not chk-lts)
            (not chk-th)
            ;(not chk-etype)
      );and
      (setq go nil)
   );if
);while

(list color ltype layer thickness ltscale
      width elevation height eflag
      style poly_ss txt_ss
)
  );defun getprops

  ;  This is a speedy little routine to tell whether the polylines in
  ;the selection set argument are of varying width or a constant value.
  ;Looping through the vertex's has to be done for old polylines when
  ;the polyline header has width values of 0.0. Basically, in this case,
  ;information in the polyline entity header is abmiguous. Width values
  ;of 0.0 in the header entity could mean the polyline has a constant
  ;width of 0.0 or it could mean that the polyline has vertex's of varying
  ;width.
  ;
  ;  It's all in wrist. Err a.., I mean it's all in the 'if'
  ;;
  (defun pl_width_getter ( ss / ss2 ss3 n na e1 width width_a width_b flag flag2)

(if ss
   (command "_.select" ss "")
);if
(setq width ""
      flag nil
      flag2 nil
);setq
(if (not
      (and ss
            (setq ss2 (ssget "p" '((0 . "LWPOLYLINE"))));setq
            (setq na (ssname ss2 0)
                  width (cdr (assoc 43 (entget na)))
            );setq
            (setq ss3 (ssget "p" (list '(0 . "LWPOLYLINE")
                                       (cons 43 width)
                                 );list
                     );ssget
            );setq
            (setq flag T)
            (equal (sslength ss2) (sslength ss3))
      );and
   );not
   (progn
      (if flag
         (setq width nil)
      );if
   );progn
);if

(if (not
      (and
         ss
         (progn (command "_.select" ss "")
                  (setq ss2 (ssget "p" '((0 . "POLYLINE"))));setq
         )
         (setq    na (ssname ss2 0)
                     e1 (entget na)
               width_a (cdr (assoc 40 e1))
               width_b (cdr (assoc 41 e1))
         );setq
         (equal width_a width_b)
         (setq ss3 (ssget "p" (list '(0 . "POLYLINE")
                                       (cons 40 width_a)
                                       (cons 41 width_b)
                              );list
                     );ssget
         );setq
         (setq flag2 T)
         (equal (sslength ss2) (sslength ss3))
      );and
   );not
   (progn
      (if flag2
         (setq width nil);setq
      );if
   );progn then
   (progn
      (if (or (equal width "")
            (not flag)
         );or
         (setq width width_a)
         (progn
         (if (not (equal width width_a))
               (setq width "")
         );if
         );progn
      );if
   );progn
);if

;now for the special handling for old polylines
(if (and width
         (equal width 0.0)
         flag2
   );and
   (progn

      (setq n 0);setq
      (while (and (equal width 0.0)
                  (< n (sslength ss3))
            );and
      (setq flag nil
               na (ssname ss3 n)
               na (entnext na)
               e1 (entget na)
      );setq
      (while (not flag)
      (if (or (equal (cdr (assoc 0 e1)) "SEQEND")
               (not (equal (cdr (assoc 40 e1)) 0.0))
               (not (equal (cdr (assoc 41 e1)) 0.0))
            );or
            (progn
            (setq flag T);
            (if (not (equal (cdr (assoc 0 e1)) "SEQEND"))
               (setq width nil)
            );if
            );progn then jump out of the loop
            (setq na (entnext na)
                  e1 (entget na)
            );setq
      );if
      );while
      (setq n (+ n 1));setq
      );while

   );progn then it's a legacy
);if ;legacy polylines that may have varying widths

(if (not width)
   (setq width "");setq
);if
(if (not (equal 'STR (type width)))
   (setq width (ai_rtos width));setq
);if

width
  );defun pl_width_getter

  (defun match-col (/ ncolor)
(setq ncolor (cdr (assoc 62 elist)))
(if (not ncolor) (setq ncolor 256))
(if (/= color ncolor)
   (progn
      (setq chk-col nil)
      (setq color nil)
   )
)
  )

  (defun match-lt (/ nltype)
(setq nltype (cdr (assoc 6 elist)))
(if (not nltype) (setq nltype "BYLAYER"))
(if (/= ltype nltype)
   (progn
      (setq chk-lt nil)
      (setq ltype ;|MSG0|;"Varies")
   )
)
  )

  (defun match-lay (/ nlayer)
(setq nlayer (cdr (assoc 8 elist)))
(if (/= layer nlayer)
   (progn
      (setq chk-lay nil)
      (setq layer ;|MSG0|;"Varies")
   )
)
  )

  (defun match-th (/ nthickness)
(setq nthickness (cdr (assoc 39 elist)))
(if (not nthickness) (setq nthickness 0))
(if (/= thickness nthickness)
   (progn
      (setq chk-th nil)
      (setq thickness ;|MSG0|;"Varies")
   )
)
  )

  (defun match-lts (/ nltscale)
(setq nltscale (cdr (assoc 48 elist)))
(if (not nltscale) (setq nltscale 1))
(if (/= ltscale nltscale)
   (progn
      (setq chk-lts nil)
      (setq ltscale ;|MSG0|;"Varies")
   )
)
  )

  ;;
  ;; If an item is a member of the list, then return its index number, else
  ;; return nil.
  ;;
  (defun getindex (item itemlist / m n)
(setq n (length itemlist))
(if (> (setq m (length (member item itemlist))) 0)
      (- n m)
      nil
)
  )
  ;;
  ;; This function is called if the linetype is set "BYLAYER". It finds the
  ;; ltype of the layer so it can be displayed beside the linetype button.
  ;;
  (defun bylayer_lt (/ layname layinfo ltype)
(if lay-idx
   (progn
      (setq layname (nth lay-idx laynmlst))
      (setq layinfo (tblsearch "layer" layname))
      (setq ltype (cdr (assoc 6 layinfo)))
      (strcat "BYLAYER" " (" ltype ")")
   )
   "BYLAYER"
)
  )
  ;;
  ;; This function is called if the color is set "BYLAYER".  It finds the
  ;; color of the layer so it can be displayed  beside the color button.
  ;;
  (defun bylayer_col (/ layname layinfo color)
(if lay-idx
   (progn
      (setq layname (nth lay-idx laynmlst))
      (setq layinfo (tblsearch "layer" layname))
      (setq color (abs (cdr (assoc 62 layinfo))))
      (setq cn color)
      (strcat "BYLAYER" " (" (colorname color) ")")
   )
   (progn
      (setq layname elayer)
      (if (and (/= elayer "")
               (/= elayer "Varies")
         );and
         (progn
         (setq layinfo (tblsearch "layer" elayer))
         (setq color (abs (cdr (assoc 62 layinfo))))
         (setq cn color)
         (strcat "BYLAYER" " (" (colorname color) ")")
         )
         (progn
         (setq cn 0)
         "BYLAYER"
         )
      );if
   );progn
);if
  )
  ;;
  ;; If there is no error message, then close the dialogue
  ;;
  ;; If there is an error message, then set focus to the tile
  ;; that's associated with the error message.
  ;;
  (defun test-ok ( / errtile)
(setq errtile (get_tile "error"))
(cond
   (  (= errtile "")
      (done_dialog 1))
   (  (= errtile "Invalid thickness.")
      (mode_tile "eb_thickness" 2))
)
  )
  ;;
  ;; OK in main dialogue.
  ;;
  (defun test-main-ok ( / flag)
(setq flag T)
(if (not (or (distof (get_tile "eb_thickness"))
            (= "" (get_tile "eb_thickness"))
         );or
   );not
   (progn
      (set_tile "error" "Invalid thickness.")
      (mode_tile "eb_thickness" 2)
      (setq flag nil);setq
   );progn
);if
(if (and flag
         (not (or (< 0 (distof (get_tile "eb_ltscale")))
                  (= "" (get_tile "eb_ltscale"))
               );or
         );not
   );and
   (progn
      (set_tile "error" "Invalid ltscale.")
      (mode_tile "eb_ltscale" 2)
      (setq flag nil);
   );progn then
);if
(if (and flag
      ; Don't test the tile's value unless it's enabled.
      ; We're not set up for the display-only value
      ; of "" here in the error handler.
      (= 2 (logand 2 eflag))
      (not (or (< 0 (distof (get_tile "text_hgt")))
               (= "" (get_tile "text_hgt"))
            );or
      );not
      );and
      (progn
      (set_tile "error" "Invalid height.")
      (mode_tile "text_hgt" 2)
      (setq flag nil);
      );progn then
);if
(if (and flag
         (= 1 (logand 1 eflag))
         (not (or (<= 0 (distof (get_tile "poly_wid")))
                  (= "" (get_tile "poly_wid"))
               );or
         );not
   );and
   (progn
      (set_tile "error" "Invalid width.")
      (mode_tile "poly_wid" 2)
      (setq flag nil)
   );progn then
);if
(if (and flag
         (= 1 (logand 1 eflag))
         (not (or (distof (get_tile "poly_elev"))
                  (= "" (get_tile "poly_elev"))
               );or
         );not
      );and
      (progn
      (set_tile "error" "Invalid elevation.")
      (mode_tile "poly_elev" 2)
      (setq flag nil)
      );progn then
);if
(if flag
   (done_dialog 1)
);if
  );defun test-main-ok

  ;;
  ;; A color function used by getlayer.
  ;;
  (defun colorname (colnum)
(setq cn (abs colnum))
(cond ((= cn 1) "red")
      ((= cn 2) "yellow")
      ((= cn 3) "green")
      ((= cn 4) "cyan")
      ((= cn 5) "blue")
      ((= cn 6) "magenta")
      ((= cn 7) "white")
      (T (itoa cn))
)
  );defun

;;; Construct layer and ltype lists and initialize all
;;; program variables:

;  (makelaylists)                   ; layer list - laynmlst

  (makeltlists)                   ; linetype lists - ltnmlst, mdashlist

  ;; Find the property values of the selection set.
  ;; (getprops ss) returns a list of properties from
  ;; a selection set - (color ltype layer thickness HEGHT STYLE WIDTH).

  (setq proplist (getprops ss));@rk interesting things happen here

  (setq
         ecolor (car proplist)
         eltype (nth 1 proplist)
         elayer (nth 2 proplist)
      ethickness (nth 3 proplist)
      eltscale (nth 4 proplist)
         ewidth (nth 5 proplist)
      eelevation (nth 6 proplist)
         eheight (nth 7 proplist)
         ;etype (nth 8 proplist);commented out and replaced with the line below. RK.
         eflag (nth 8 proplist)
         estyle (nth 9 proplist)
         poly_ss (nth 10 proplist)
         txt_ss  (nth 11 proplist)
  );setq

  ;; Find index of linetype, and layer lists
  (cond
((= eltype "Varies") (setq lt-idx nil))
((= eltype "BYLAYER")
   (setq lt-idx (getindex "BYLAYER" ltnmlst)))
((= eltype "BYBLOCK")
   (setq lt-idx (getindex "BYBLOCK" ltnmlst)))
(T (setq lt-idx (getindex eltype ltnmlst)))
  )
  (if (= elayer "Varies")
   (setq lay-idx nil)
   (setq lay-idx (getindex elayer laynmlst))
  );if
  (if (= ethickness "")
   (setq ethickness nil)
  );if
  (if (= eltscale "")
   (setq eltscale nil)
  );if

);defun ddchprop2_init ; end (ddchprop2_init)

;;; (ddchprop2_select)
;;;
;;; Aquires selection set for DDCHPROP2, in one of three ways:
;;;
;;; 1 - Autoselected.
;;; 2 - Prompted for.
;;; 3 - Passed as an argument in a call to (ddchprop2 <ss> )
;;;
;;; The (ddchprop2_select) function also sets the value of the
;;; global symbol AI_SELTYPE to one of the above three values to
;;; indicate the method thru which the entity was aquired.

(defun ddchprop2_select ( / )

;returns only entities in ss that are in the current space.
(defun ss_in_current_space ( ss / a cur_space ss2)

(if ss
   (progn
   (if (and (equal (getvar "tilemode") 0)
            (equal (getvar "cvport") 1)
      );and
      (setq cur_space 1);then paper space is where we are.
      (setq cur_space 0);else model space.
   );if
   (command "_.select" ss "")
   (setq ss2 (ssget "p" (list (cons 67 cur_space))));setq
   (cond                            ;;;;;tell the user what's going on.
   ((not ss2) (princ "\nNo objects found in current space."))
   ((not (equal (sslength ss) (sslength ss2)))
      (princ (strcat "\n" (itoa (- (sslength ss) (sslength ss2)))
                     " object(s) were not in current space."
            )
      )
   )
   );cond
   );progn then
);if
ss2
);defun ss_in_current_space

;;;begin the work of ddchprop2_select

;; temporarily restore original highlight setting.
(b_set_sysvars (assoc "HIGHLIGHT" (car bonus_varlist)))
(cond
((and ss
      (eq (type ss) 'pickset)
)       ; selection set passed to
(cond                                  ; (ddchprop2) as argument
   ((not (zerop (sslength ss)))    ; If not empty, then
   (setq ai_seltype 3)             ; then return pickset.
   (ai_return ss)
   )
);cond close
);cond #1
((setq ss (ai_aselect)))                         ; Use current selection
                                                   ; set or prompt for objects
(T (princ "\nNothing selected.")
   (ai_return nil)
)
);cond close
(b_restore_sysvars)

;(if ss
; (setq ss (ss_remove_locked ss))
;);if
(if ss
   (setq ss (ss_in_current_space ss))
);if

ss
);defun ddchprop2_select

;;; Define command function.
(defun C:CCH ()
  (ddchprop2 nil)
  (princ)
);defun

;;; Main program function - callable as a subroutine.
;;;
;;; (ddchprop2 <pickset> )
;;;
;;; <pickset> is the selection set of objects to be changed.
;;;
;;; If <pickset> is nil, then the current selection set is
;;; aquired, if one exists.  Otherwise, the user is prompted
;;; to select the objects to be changed.
;;;
;;; Before (ddchprop2) can be called as a subroutine, it must
;;; be loaded first.  It is up to the calling application to
;;; first determine this, and load it if necessary.

(defun ddchprop2 (ss  /

               a
               add-mdash
               assoclist
               bit-70
               boxlength
               bylayer-lt
               bylayer_col
               bylayer_lt
               call_chp2
               chk-col
               ;chk-etype       ;var removed by rk
               chk-lay
               chk-lt
               chk-lts          ;var added by rk
               chk-th
               cmd
               cmdecho
               cn
               cnum
               col-idx
               col_def
               col_tile
               colname
               colnum
               color
               colorname
               cvpname
               dash
               dashdata
               dashlist
               dashsize
               dcl_id
               ddchprop-err
               drawpattern
               ecolor
               eelevation
               eflag
               eheight
               elayer
               elevation
               elist
               eltscale
               eltype
               en
               ename
               ESTYLE          ;var added by rk
               ethickness
               ;etype          ;var removed by rk
               ewidth
               fchk
               frozth
               fx
               getcolor
               GETELEVATION    ;function added by rk
               GETHEIGHT       ;function added by rk
               getindex
               getlayer
               ;get_locked_layers ;function added and then removed by rk
               getltype
               getprops
               getscale       ;function added by rk
               GETSTYLE       ;function added by rk
               getthickness
               GETWIDTH       ;function added by rk
               globals
               HAIR_STYLE_LIST ;var added by rk
               height
               index
               item
               item1
               item2
               itemlist
               lay-idx
               layedit_act
               layer
               layinfo
               laylist
               laylist_act
               layname
               laynmlst
               layvalue
               linetype
               list1
               longlist
               lt-idx
               ltabstr
               ltedit_act
               ltidx
               ltlist
               ltlist1
               ltlist_act
               ltname
               ltnmlst
               ltvalue
               ltype
               m
               makelaylists
               makeltlists
               match-col
               ;match-etype       ;function removed by rk
               match-in
               match-lay
               match-lt
               match-lts
               match-th
               match_col
               mdashlist
               ;MPOPLST             ;function added and then move to ac_bonus.lsp by rk
               n
               name
               ncolor
               nlayer
               nltype
               nthickness
               off
               old-idx
               olderr
               on
               onoff
               patlist
               pattern
               PL_WIDTH_GETTER    ;function added by rk
               POLY_SS             ;var added by rk
               ;POSITION             ;function added by rk and then moved to ac_bonus.lsp
               proplist
               reset-lay
               reset-lt
               s
               selset
               set_col_tile
               sortlist
               ss
               ss_in_current_space  ;function add by rk.
               ss-index
               ss-length
               ;ss_remove_locked    ;function added and then removed by rk.
               sslen
               temp_color
               templist
               test-main-ok
               test-ok
               testidx
               testlay
               th-value
               thickness
               tile
               tile_rect
               tilemode
               ;TNLIST          ;function removed and moved to ac_bonus.lsp by rk
               TXT_SS          ;var added by rk
               ;undo_init       ;removed by rk.
               vi
               vpf
               vpldata
               vpn
               which_tiles
               width
               x
               x1
               x2
               xdlist
               y
               y1
               y2
            )

  (if (and (not init_bonus_error)
         (equal -1 (load "ac_bonus.lsp"  -1))
   );and
   (progn (alert "Error:\n    Cannot find AC_BONUS.LSP.")(exit))
  );if
  (init_bonus_error (list
                  (list "cmdecho" 0
                        "highlight" 0
                        "regenmode" 1
                           "ucsicon" 0
                  )
                  T    ;flag. True means use undo for error clean up.
                  );list
  );init_bonus_error

  (cond
   (  (not (ai_notrans)))                      ; Not transparent?
   (  (not (ai_acadapp)))                      ; ACADAPP.EXP xloaded?
   (  (not (setq dcl_id (ai_dcl "exchprop")))) ; is .DCL file loaded?
   (  (not (setq ss (ddchprop2_select))))    ; objects to modify?
   (t
      ;(ai_undo_push)
      (ddchprop2_init)                         ; Everything's cool,
      (call_chp2)                            ; so proceed!
      ;(ai_undo_pop)
   )
  );cond close

  (restore_old_error)

(princ)
);defun ddchprop2

;;;----------------------------------------------------------------------------

(princ " EXCHPROP loaded.")
(princ)

;;;----------------------------------------------------------------------------
;;;---------------------------------DDCOLOR_LSP--------------------------------
;;;----------------------------------------------------------------------------

; Next available MSG number is 24
; MODULE_ID DDCOLOR_LSP_
;;;
;;; ddcolor.lsp
;;;
;;; Copyright 1990, 1992, 1994, 1996 by Autodesk, Inc.
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and
;;; that both that copyright notice and the limited warranty and
;;; restricted rights notice below appear in all supporting
;;; documentation.
;;;
;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;; UNINTERRUPTED OR ERROR FREE.
;;;
;;; Use, duplication, or disclosure by the U.S. Government is subject to
;;; restrictions set forth in FAR 52.227-19 (Commercial Computer
;;; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;; (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;.
;;;
;;;----------------------------------------------------------------------------
;;; DESCRIPTION
;;;
;;; Chromatic Pallete style color selection dialog.
;;;
;;; Globals:
;;;
;;;       chroma_color - Integer color index.  The last value selected
;;;             by the user in chroma dialog.  It is not cleared or reset
;;;             by a cancel.  Only used for communication between callback
;;;             functions and the (chroma) funciton.
;;;
;;; Depends on the definitions for the dialog provided in chroma.dcl.
;;;
;;;
;;; C:DDCOLOR -- Dialogue front end to the CECOLOR sysvar.  Uses the chroma
;;; pallete style color selector.
;;;
;;; ===========================================================================
;;; ===================== load-time error checking ============================
;;;

  (defun ai_abort (app msg)
   (defun *error* (s)
      (if old_error (setq *error* old_error))
      (princ)
   )
   (if msg
   (alert (strcat " Application error: "
                  app
                  " \n\n  "
                  msg
                  "  \n"
            )
   )
   )
   (exit)
  )

;;; Check to see if AI_UTILS is loaded, If not, try to find it,
;;; and then try to load it.
;;;
;;; If it can't be found or it can't be loaded, then abort the
;;; loading of this file immediately, preserving the (autoload)
;;; stub function.

  (cond
   (  (and ai_dcl (listp ai_dcl)))       ; it's already loaded.

   (  (not (findfile "ai_utils.lsp"))                   ; find it
      (ai_abort "DDCOLOR"
               (strcat "Can't locate file AI_UTILS.LSP."
                        "\n Check support directory.")))

   (  (eq "failed" (load "ai_utils" "failed"))          ; load it
      (ai_abort "DDCOLOR" "Can't load file AI_UTILS.LSP"))
  )

  (if (not (ai_acadapp))             ; defined in AI_UTILS.LSP
   (ai_abort "DDCOLOR" nil)       ; a Nil <msg> supresses
  )                                  ; ai_abort's alert box dialog.

;;; ==================== end load-time operations ===========================

(defun c:ccc (/ co_oce clrx co_err co_oer lay_clr)

  ;; Main Color function, called by setup code.
  (defun ddcolor_main()

(graphscr)

;; Get the color of the current layer, for possible BYLAYER color swatch.
(setq lay_clr (cdr (assoc 62 (tblsearch "layer" (getvar "clayer")))))

;; Call the dialog here...
(setq clr (acad_colordlg (cstoci (getvar "cecolor")) T lay_clr))

(if clr
   (setvar "CECOLOR" (citocs clr)))
  )

  ;;;
  ;;; CSTOCI -- Color string to color index
  ;;; Convert an arbitrary case string into a color index.
  ;;; Returns nil if string is not a valid color.
  ;;;
  (defun cstoci (str)
(setq str (strcase str))
(cond
   ((= str "RED")       1)
   ((= str "YELLOW")    2)
   ((= str "GREEN")    3)
   ((= str "CYAN")    4)
   ((= str "BLUE")    5)
   ((= str "MAGENTA") 6)
   ((= str "WHITE")    7)
   ((= str "BYLAYER")  256)
   ((= str "BYBLOCK") 0)
   ((= str "BY LAYER") 256)
   ((= str "BY BLOCK") 0)
   ((and (< 0 (atoi str)) (> 256 (atoi str))) (atoi str))
   (nil))
  )

  ;;;
  ;;; CITOCS -- Convert color index into standard color name.
  ;;; Will return the standard and logical color names as text
  ;;; strings.  Returns nil for out-of-range color indicies.
  ;;;
  (defun citocs(i)
(cond
   ((= i 0) "BYBLOCK")
   ((= i 1) "red")
   ((= i 2) "yellow")
   ((= i 3) "green")
   ((= i 4) "cyan")
   ((= i 5) "blue")
   ((= i 6) "magenta")
   ((= i 7) "white")
   ((= i 256) "BYLAYER")
   ((and (< 0 i) (> 256 i)) (itoa i))
   (nil))
  )

  ;; Start of ddcolor
  (setq old_cmd (getvar "cmdecho") ; save current setting of cmdecho
      old_error  *error*          ; save current error function
      *error* ai_error             ; new error function
  )

  (setvar "cmdecho" 0)

  (cond
   (  (not (ai_trans)))                      ; transparent OK
   (  (not (ai_acadapp)))                   ; ACADAPP.EXP xloaded?

   (t (if (and (/= 1 (logand 1 (getvar "cmdactive")))
               (/= 8 (logand 8 (getvar "cmdactive")))
         )
      (ai_undo_push)
      )

      (ddcolor_main)                         ; proceed!

      (if (and (/= 1 (logand 1 (getvar "cmdactive")))
               (/= 8 (logand 8 (getvar "cmdactive")))
         )
      (ai_undo_pop)
      )
   )
  )

  (setq *error* old_error)
  (setvar "cmdecho" old_cmd)
  (princ)

)

;;;----------------------------------------------------------------------------

(princ "  DDCOLOR loaded.  ")
(princ)

;;;--------------------------------------------------------------------------;
;;;---------------Chon NHANH Nhieu Doi Tuong GIONG THUOC TINH----------------;
;;;--------------------------------------------------------------------------;
;;; ssx.lsp
;;; Copyright (C) 1990 by Autodesk, Inc.
;;; Copyright (C) 1991 by Control Systems, Inc.
;;;
;;; Permission to use, copy, modify, and distribute this software and its
;;; documentation for any purpose and without fee is hereby granted.
;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY.
;;; ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF
;;; MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;; Larry Knott                      Version 2.0 7/18/88
;;; Carl Bethea & Jan S. Yoder       Version 3.0
;;; Enhancements to (ssx).
;;; 15 March 1990
;;;
;;; ARTIST Software, Inc             Version 4.0 December 1991
;;; Modified for FLEXICON usage. If the variable FLEXVAR = 1,
;;; use Flexicon menus
;;;
;;;--------------------------------------------------------------------------;
;;; DESCRIPTION
;;;                            SSX.LSP
;;;
;;; "(SSX)" -  Easy SSGET filter routine.
;;;
;;; Creates a selection set.  Either type "SSX" at the "Command:" prompt
;;; to create a "previous" selection set or type "(SSX)" in response to
;;; any "Select objects:" prompt.  You may use the functions "(A)" to add
;;; entities and "(R)" to remove entities from a selection set during
;;; object selection.  More than one filter criteria can be used at a
;;; time.
;;;
;;; SSX returns a selection set either exactly like a selected
;;; entity or, by adjusting the filter list, similar to it.
;;;
;;; The initial prompt is this:
;;;
;;;    Command: ssx
;;;    Select object/<None>: (RETURN)
;;;    >>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
;;;
;;; Pressing RETURN at the initial prompt gives you a null selection
;;; mechanism just as (ssx) did in Release 10, but you may select an
;;; entity if you desire.  If you do so, then the list of valid types
;;; allowed by (ssget "x") are presented on the command line.
;;;
;;;    Select object/<None>:  (a LINE selected)
;;;    Filter: ((0 . "LINE") (8 . "0") (39 . 2.0) (62 . 1) (210 0.0 0.0 1.0))
;;;    >>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
;;;
;;; At this point any of these filters may be removed by selecting the
;;; option keyword, then pressing RETURN.
;;;
;;;    >>Layer name to add/<RETURN to remove>: (RETURN)
;;;
;;;    Filter: ((0 . "LINE") (39 . 2.0) (62 . 1) (210 0.0 0.0 1.0))
;;;    >>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
;;;
;;; If an item exists in the filter list and you elect to add a new item,
;;; the old value is overwritten by the new value, as you can have only
;;; one of each type in a single (ssget "x") call.
;;;
;;;--------------------------------------------------------------------------;
;;;
;;; Find the dotted pairs that are valid filters for ssget
;;; in entity named "ent".
;;;
;;; ssx_fe == SSX_Find_Entity
;;;
(defun ssx_fe (/ x data fltr ent)
  (if (and (= flexvar 1)(/= t2 "Pick"))
(setq ent nil)
(setq ent (car (entsel "\nSelect object/<None>: ")))
  )
  (if ent
(progn
   (setq data (entget ent))
   (foreach x '(0 2 6 7 8 39 62 66 210) ; do not include 38
      (if (assoc x data)
      (setq fltr
         (cons (assoc x data) fltr)
      )
      )
   )
   (reverse fltr)
)
  )
)
;;;
;;; Remove "element" from "alist".
;;;
;;; ssx_re == SSX_Remove_Element
;;;
(defun ssx_re (element alist)
  (append
(reverse (cdr (member element (reverse alist))))
(cdr (member element alist))
  )
)
;;;
;;; INTERNAL ERROR HANDLER
;;;
(defun ssx_er (s)                   ; If an error (such as CTRL-C) occurs
                                    ; while this command is active...
  (if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
  )
  (if olderr (setq *error* olderr)) ; Restore old *error* handler
  (setq flexvar 0)
  (princ)
)
;;;
;;; Flexicon call routine
;;;
(defun flexmnu (a)
(if (= flexvar 1)
  (command "FLEXICON" (strcat "FLEX" a))
)
)

;;;
;;; Get the filtered sel-set.
;;;
;;;
(defun ssx (/ olderr)
  (gc)                               ; close any sel-sets
  (setq olderr *error*
      *error* ssx_er
  )
  (setq fltr (ssx_fe))
  (ssx_gf fltr)
  (if (= flexvar 1)
(progn
(prompt "\n \n \nNow select the required EDIT command and (P)revious.")
(flexmnu "EDIT")
)
(command "p")
  )
  (princ)
)
;;;
;;; Build the filter list up by picking, selecting an item to add,
;;; or remove an item from the list by selecting it and pressing RETURN.
;;;
;;; ssx_gf == SSX_Get_Filters
;;;
(defun ssx_gf (f1 / t1 t2 t3 f1 f2)
  (while
(progn
   (flexmnu "SSX")
   (cond (f1 (prompt "\nFilter: ") (prin1 f1)))
   (initget
      "Block Color Entity Flag LAyer LType Pick Style Thickness Vector")
   (setq t1 (getkword (strcat
      "\n>>Block name/Color/Entity/Flag/"
      "LAyer/LType/Pick/Style/Thickness/Vector: ")))
)
(setq t2
   (cond
      ((eq t1 "Block")    2) ((eq t1 "Color")    62)
      ((eq t1 "Entity")    0) ((eq t1 "LAyer")    8)
      ((eq t1 "LType")    6) ((eq t1 "Style")    7)
      ((eq t1 "Thickness") 39) ((eq t1 "Flag" )    66)
      ((eq t1 "Vector") 210)
      (T t1)
   )
)
(setq t3
   (cond
      ((= t2  2)
      (if (= flexvar gtads 1)
      (progn
         (prompt "\n>>Block name to add/<RETURN to remove>: ")
         (gttable "BLOCK")
      )
      (getstring "\n>>Block name to add/<RETURN to remove>: ")
      )
      )
      ((= t2 62)  (initget 4 "?")
      (cond
         ((or (eq (setq t3 (getint
            "\n>>Color number to add/?/<RETURN to remove>: ")) "?")
            (> t3 256))
            (ssx_pc)             ; Print color values.
            nil
         )
         (T
            t3                   ; Return t3.
         )
      )
      )
      ((= t2  0) (getstring "\n>>Entity type to add/<RETURN to remove>: "))
      ((= t2  8)
      (if (= flexvar gtads 1)
      (progn
         (prompt "\n>>Layer name to add/<RETURN to remove>: ")
         (gttable "LAYER")
      )
      (getstring "\n>>Layer name to add/<RETURN to remove>: ")
      )
      )
      ((= t2  6)
      (if (= flexvar gtads 1)
      (progn
         (prompt "\n>>Linetype name to add/<RETURN to remove>: ")
         (gttable "LTYPE")
      )
      (getstring "\n>>Linetype name to add/<RETURN to remove>: ")
      )
      )
      ((= t2  7)
      (if (= flexvar gtads 1)
      (progn
         (prompt "\n>>Text style name to add/<RETURN to remove>: ")
         (gttable "STYLE")
      )
      (getstring "\n>>Text style name to add/<RETURN to remove>: ")
      )
      )
      ((= t2 39)
         (prompt "\n>>Thickness to add/<RETURN to remove>: ")
         (if(= flexvar gtads 1)(gtfnum"Thickness to add:")(getreal))
      )
      ((= t2 66)  (if (assoc 66 f1) nil 1))
      ((= t2 210)
      (getpoint  "\n>>Extrusion Vector to add/<RETURN to remove>: ")
      )
      (T       nil)
   )
)
(cond
   ((= t2 "Pick") (setq f1 (ssx_fe) t2 nil)) ; get entity
   ((and f1 (assoc t2 f1))       ; already in the list
      (if (and t3 (/= t3 ""))
      ;; Replace with a new value...
      (setq f1 (subst (cons t2 t3) (assoc t2 f1) f1))
      ;; Remove it from filter list...
      (setq f1 (ssx_re (assoc t2 f1) f1))
      )
   )
   ((and t3 (/= t3 ""))
      (setq f1 (cons (cons t2 t3) f1))
   )
   (T nil)
)
  )
  (if f1 (setq f2 (ssget "x" f1)))
  (setq *error* olderr)
  (if (and f1 f2)
(progn
   (princ (strcat "\n" (itoa (sslength f2)) " found. "))
   f2
)
(progn (princ "\n0 found.") (prin1))
  )
)
;;;
;;; Print the standard color assignments.
;;;
;;;
(defun ssx_pc ()
  (if textpage (textpage) (textscr))
  (princ "\n                                                    ")
  (princ "\n                Color number | Standard meaning ")
  (princ "\n             ________________|____________________")
  (princ "\n                               |                   ")
  (princ "\n                      0       |    <BYBLOCK>    ")
  (princ "\n                      1       |    Red          ")
  (princ "\n                      2       |    Yellow       ")
  (princ "\n                      3       |    Green       ")
  (princ "\n                      4       |    Cyan       ")
  (princ "\n                      5       |    Blue       ")
  (princ "\n                      6       |    Magenta    ")
  (princ "\n                      7       |    White       ")
  (princ "\n                   8...255    |    -Varies-    ")
  (princ "\n                   256    |    <BYLAYER>    ")
  (princ "\n                                              \n\n\n")
)
;;;
;;; C: function definition.
;;;
(defun c:ssx () (ssx)(princ))
(princ "\n\tType \"ssx\" at a Command: prompt or ")
(princ "\n\t(ssx) at any object selection prompt. ")
(princ)

;;;--------------------------------------------------------------------------;
;;;--------------------------------------------------------------------------;
;;;--------------------------------------------------------------------------;
(defun S::STARTUP ()
(setvar "cmdecho" 0)
(setvar "cmdecho" 1)
(setvar "LTSCALE" 10)

;(command "_load" "chenKH.fas")
;(command "_load" "ctcot.fas")
;(command "_load" "damdoc.fas")
;(command "_load" "ghichu.fas")
;(command "_load" "hamtutao.lsp")
;(command "_load" "KHOITAO.fas")
;(command "_load" "KHthep.fas")
;(command "_load" "mbmong.dcl")
;(command "_load" "mbmong.fas")
;(command "_load" "mccot.fas")
;(command "_load" "mcdam.fas")
;(command "_load" "mcmong1.dcl")
;(command "_load" "mcmong1.fas")
;(command "_load" "mcmong2.dcl")
;(command "_load" "mcmong2.fas")
;(command "_load" "mcmong3.dcl")
;(command "_load" "mcmong3.fas")
;(command "_load" "mcsan.fas")
;(command "_load" "thepdai.fas")
;(command "_load" "thepdoc.fas")
;(command "_load" "thepmb.fas")
;(command "_load" "thepphbo.fas")
(command "_script" "thongso.scr")
;(command "_load" "thongso1.dcl")
;(command "_load" "thongso1.fas")
;(command "_load" "thongso2.dcl")
;(command "_load" "thongso2.fas")
;(command "_load" "tietdien.fas")
;(command "_load" "vehan.fas")
(command "_load" "phamduy782006htd.dcl")
(command "_load" "DDCHPROP.dcl")
(command "_load" "EXCHPROP.dcl")
(command "_load" "DDMODIDY.dcl")
(command "_load" "TK.dcl")
(command "_load" "TK_LIB.dcl")
(princ)
)

(load "D:\\S E T U P Thuong Xuyen\\1st OFFICE\\0st RUN-2000\\DDCHPROP.LSP")

(load "D:\\S E T U P Thuong Xuyen\\1st OFFICE\\0st RUN-2000\\SSX.LSP")

;(load "D:\\S E T U P Thuong Xuyen\\1st OFFICE\\0st RUN-2000\\phamDuy782006_TKT_VNI.LSP")
;(load "D:\\S E T U P Thuong Xuyen\\1st OFFICE\\0st RUN-2000\\phamduy782006ganhtd.LSP")
;(load "D:\\S E T U P Thuong Xuyen\\1st OFFICE\\0st RUN-2000\\phamduy782006ganhtds.LSP")

(load "D:\\S E T U P Thuong Xuyen\\1st OFFICE\\0st RUN-2000\\THONGKE-THEP\\TK_EXP.LSP")
(load "D:\\S E T U P Thuong Xuyen\\1st OFFICE\\0st RUN-2000\\THONGKE-THEP\\TKN.LSP")

;(load "D:\\S E T U P Thuong Xuyen\\1st OFFICE\\0st RUN-2000\\ACAD iit insertTEXT - iiT.LSP")

;(load "D:\\S E T U P Thuong Xuyen\\1st OFFICE\\0st RUN-2000\\ACAD iit insertTEXT - iPT.LSP")

(load "D:\\S E T U P Thuong Xuyen\\1st OFFICE\\0st RUN-2000\\ACAD insertPOINT - PTA4.LSP")

;; Silent load.
(princ)

;; Silent load for the Express Tools.
;; Altering this line will affect Express Tools functionality
(load "acettest.fas" (princ))

;------BLOCK NAME Put The End because ERROR other LISP-------
;------------------------BODER HATCH-------------------------

;;; HATCHB.LSP ver 2.5
;;; Recreates hatch boundary by selecting a hatch
;;; Known problem with some elipses and splines
;;; By Jimmy Bergmark
;;; Copyright (C) 1997-2008 JTB World, All Rights Reserved
;;; Website: www.jtbworld.com
;;; E-mail: info@jtbworld.com
;;; 2000-02-12 - First release
;;; 2000-03-27 - Counterclockwise arcs and ellipses fixed
;;;             Objects created joined to lwpolyline if possible
;;;             Error-handling, undo of command
;;;             Can handle PLINETYPE = 0,1,2
;;; 2000-03-30 - Integrating hatchb and hatchb14
;;;             Selection of many hatches
;;;             Splines supported if closed.
;;; 2001-04-02 - Fixed bug with entmake of line with no Z for r14
;;; 2001-07-31 - Removed an irritating semicolon to enable polylines to be created.
;;; 2001-10-04 - Changed mail and homepage so it's easy to find when new versions comes up.
;;; 2003-02-06 - Minor fix
;;; 2003-02-17 - Area returned if no islands is found since it's not consistant
;;; 2003-05-19 - Fix to take PEDITACCEPT variable used in AutoCAD 2004 into account
;;; 2004-11-05 - Minor bugs fixed
;;; 2006-03-18 - Nothing changed from 2.1 other that it's been confirmed to work with AutoCAD 2007
;;; 2006-05-13 - Create the boundary on the same layer as the hatch using the hbl command and
;;;             on current layer/color/linetype using the hb or hatchb command
;;; 2007-02-08 - Fixed a bug with the hbl command
;;; 2008-02-29 - Support for hatches in non WCS thanks to xiaocai
;;; Tested on AutoCAD r14, 2000, 2000i, 2002, 2004, 2005, 2006, 2007, 2008, 2009
;;; should be working on older versions too.

(defun c:hb () (hatchb nil)) ; this line can be commented out if there is an existing command called hb
(defun c:hbl () (hatchb T)) ; this line can be commented out if there is an existing command called hbl
(defun c:hatchb () (hatchb nil))
(defun hatchb (hl  /    es blay  ed1 ed2 loops1    bptf  part
         et noe plist ic bul nr ang1  ang2  obj *ModelSpace* *PaperSpace*
         space cw errexit undox olderr oldcmdecho ss1 lastent en1 en2 ss lwp
         list->variantArray 3dPoint->2dPoint A2k ent i ss2
         knot-list controlpoint-list kn cn pos xv bot area hst noarea
         )
(setq A2k (>= (substr (getvar "ACADVER") 1 2) "15"))
(if A2k
(progn
   (defun list->variantArray (ptsList / arraySpace sArray)
   (setq arraySpace
            (vlax-make-safearray
            vlax-vbdouble
            (cons 0 (- (length ptsList) 1))
            )
   )
   (setq sArray (vlax-safearray-fill arraySpace ptsList))
   (vlax-make-variant sArray)
   )
   (defun areaOfObject (en / curve area)
   (if en
      (if A2k
         (progn
         (setq curve (vlax-ename->vla-object en))
         (if
            (vl-catch-all-error-p
               (setq
               area
                  (vl-catch-all-apply 'vlax-curve-getArea (list curve))
               )
            )
            nil
            area
         )
         )
         (progn
         (command "._area" "_O" en)
         (getvar "area")
         )
      )
   )
   )
)
)
(if A2k
  (defun 3dPoint->2dPoint (3dpt)
(list (float (car 3dpt)) (float (cadr 3dpt)))
  )
)

  (defun errexit (s)
(princ "\nError:  ")
(princ s)
(restore)
  )

  (defun undox ()
(command "._ucs" "_p")
(command "._undo" "_E")
(setvar "cmdecho" oldcmdecho)
(setq *error* olderr)
(princ)
  )

  (setq olderr  *error*
      restore undox
      *error* errexit
  )
  (setq oldcmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "._UNDO" "_BE")
  (if A2k (progn
(vl-load-com)
(setq *ModelSpace* (vla-get-ModelSpace
                     (vla-get-ActiveDocument (vlax-get-acad-object))
                     )
      *PaperSpace* (vla-get-PaperSpace
                     (vla-get-ActiveDocument (vlax-get-acad-object))
                     )
))
  )

; Remove for testing purpose
; (setq A2k nil)

  (if (/= (setq ss2 (ssget '((0 . "HATCH")))) nil)
(progn
(setq i 0)
(setq area 0)
(setq bMoreLoops nil)
(while (setq ent (ssname ss2 i))
   (setq noarea nil)
   (setq ed1 (entget ent))
   (setq layer (cdr (assoc 8 ed1)))
   ; (if (not (equal (assoc 210 ed1) '(210 0.0 0.0 1.0))) (princ "\nHatch not in WCS!"))  ;modified by xiaocai
   ; (setq xv (cdr (assoc 210 ed1)))                                                    ;modified by xiaocai
   (command "._ucs" "_w")
   (setq loops1 (cdr (assoc 91 ed1))) ; number of boundary paths (loops)
   (if (and A2k (= (strcase (cdr (assoc 410 ed1))) "MODEL"))
      (setq space *ModelSpace*)
      (setq space *PaperSpace*)
   )
   (repeat loops1
      (setq ed1 (member (assoc 92 ed1) ed1))
      (setq bptf (cdr (car ed1))) ; boundary path type flag
      (setq ic (cdr (assoc 73 ed1))) ; is closed
      (setq noe (cdr (assoc 93 ed1))) ; number of edges
      (setq bot (cdr (assoc 92 ed1))) ; boundary type
      (setq hst (cdr (assoc 75 ed1))) ; hatch style
      (setq ed1 (member (assoc 72 ed1) ed1))
      (setq bul (cdr (car ed1))) ; bulge
      (setq plist nil)
      (setq blist nil)
      (cond
      ((> (boole 1 bptf 2) 0) ; polyline
         (repeat noe
         (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
         (setq plist (append plist (list (trans (cdr (assoc 10 ed1)) ent 0)    ))) ;;add trans by xiaocai
         (setq blist (append blist
                              (if (> bul 0)
                                 (list (cdr (assoc 42 ed1)))
                                 nil
                              )
                     )
         )
         )
         (if A2k (progn
         (setq polypoints
                  (apply 'append
                        (mapcar '3dPoint->2dPoint plist)
                  )
         )
         (setq VLADataPts (list->variantArray polypoints))
         (setq obj (vla-addLightweightPolyline space VLADataPts))
         (setq nr 0)
         (repeat (length blist)
            (if (/= (nth nr blist) 0)
               (vla-setBulge obj nr (nth nr blist))
            )
            (setq nr (1+ nr))
         )
         (if (= ic 1)
            (vla-put-closed obj T)
         )
         (if hl (vla-put-layer obj layer))
         )
         (progn
            (setq ne (append (list '(0 . "POLYLINE")) (list (cons 66 1))))
            (if (= ic 1) (setq ne (append ne (list (cons 70 1)))))
            (if hl (setq ne (append ne (list (cons 8 layer)))))
            (entmake ne)
            (setq nr 0)
            (repeat (length plist)
            (if (= bul 0)
               (entmake (list (cons 0 "VERTEX")
                              (cons 10 (trans (nth nr plist) ent 0) );;add trans by xiaocai
                        )
               )
               (entmake (list (cons 0 "VERTEX")
                              (cons 10 (trans (nth nr plist) ent 0) );;add trans by xiaocai
                              (cons 42 (nth nr blist))
                        )
               )
            )
            (setq nr (1+ nr))
            )
            (entmake '((0 . "SEQEND")))
         )
         )
      )
      (t ; not polyline
         (setq lastent (entlast))
         (setq lwp T)
         (repeat noe
         (setq et (cdr (assoc 72 ed1)))
         (cond
            ((= et 1) ; line
            (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
            (if A2k
               (progn
                  (setq obj (vla-AddLine
                  space
                  (vlax-3d-point (trans (cdr (assoc 10 ed1)) ent 0) ) ;;add trans by xiaocai
                  (vlax-3d-point (trans (cdr (assoc 11 ed1)) ent 0) ) ;;add trans by xiaocai
                  ))
                  (if hl (vla-put-layer obj layer))
               )
               (progn
                  (setq ne (append (list (cons 0 "LINE"))
                     (list (list 10 (car (trans (cdr (assoc 10 ed1)) ent 0) ) (cadr (trans (cdr (assoc 10

ed1)) ent 0)) 0)) ;;add trans by xiaocai
                     (list (list 11 (car (trans (cdr (assoc 11 ed1)) ent 0) ) (cadr (trans (cdr (assoc 11

ed1)) ent 0)) 0)) ;;add trans by xiaocai
                     ;(cons 210 xv)
                  )
                  )
                  (if hl (setq ne (append ne (list (cons 8 layer)))))
                  (entmake ne)
               )
            )
            (setq ed1 (cddr ed1))
            )
            ((= et 2) ; circular arc
               (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
               (setq ang1 (cdr (assoc 50 ed1)))
               (setq ang2 (cdr (assoc 51 ed1)))
               (setq cw (cdr (assoc 73 ed1)))
               (if (and (equal ang1 0 0.00001) (equal ang2 6.28319 0.00001))
               (progn
                  (if A2k
                     (progn
                     (setq obj (vla-AddCircle
                        space
                        (vlax-3d-point (trans (cdr (assoc 10 ed1)) ent 0)  )
                        (cdr (assoc 40 ed1))
                     ))
                     (if hl (vla-put-layer obj layer))
                     )
                     (progn
                     (setq ne (append
                                    (list (cons 0 "CIRCLE"))
                                    (list (cons 8 layer))
                                    (list (cons 10 (trans (cdr (assoc 10 ed1)) ent 0)));;;add trans by xiaocai
                                    (list (assoc 40 ed1))
                              )
                     )
                     (if hl (setq ne (append ne (list (cons 8 layer)))))
                     (entmake ne)
                     )
                  )
                  (setq lwp nil)
               )
               (if A2k
                  (progn
                     (setq obj (vla-AddArc
                     space
                     (vlax-3d-point (trans (cdr (assoc 10 ed1)) ent 0) );;;add trans by xiaocai
                     (cdr (assoc 40 ed1))
                     (if (= cw 0)
                        (- 0 ang2)
                        ang1
                     )
                     (if (= cw 0)
                        (- 0 ang1)
                        ang2
                     )
                     ))
                     (if hl (vla-put-layer obj layer))
                  )
                  (progn
                     (setq ne (append (list (cons 0 "ARC"))
                                 (list (cons 10 (trans (cdr (assoc 10 ed1)) ent 0) ));;add trans by xiaocai
                                 (list (assoc 40 ed1))
                                 (list (cons 50
                                       (if (= cw 0)
                                          (- 0 ang2)
                                          ang1
                                       )
                                 ))
                                 (list (cons 51
                                       (if (= cw 0)
                                          (- 0 ang1)
                                          ang2
                                       )
                                 ))
                           )
                     )
                     (if hl (setq ne (append ne (list (cons 8 layer)))))
                     (entmake ne)
                  )
               )
               )
               (setq ed1 (cddddr ed1))
            )
            ((= et 3) ; elliptic arc
            (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
            (setq ang1 (cdr (assoc 50 ed1)))
            (setq ang2 (cdr (assoc 51 ed1)))
            (setq cw (cdr (assoc 73 ed1)))
            (if A2k (progn
               (setq obj (vla-AddEllipse
                           space
                           (vlax-3d-point (trans (cdr (assoc 10 ed1)) ent 0) )
                           (vlax-3d-point (trans (cdr (assoc 11 ed1)) ent 0) );;add trans by xiaocai
                           (cdr (assoc 40 ed1))
                        )
               )
               (vla-put-startangle obj (if (= cw 0) (- 0 ang2) ang1))
               (vla-put-endangle obj (if (= cw 0) (- 0 ang1) ang2))
               (if hl (vla-put-layer obj layer))
               )
               (progn
               (princ "\nElliptic arc not supported!")
               (setq noarea T)
               )
            )
            (setq lwp nil)
            )
            ((= et 4) ; spline
            (setq ed1 (member (assoc 94 (cdr ed1)) ed1))
            (setq knot-list nil)
            (setq controlpoint-list nil)
            (setq kn (cdr (assoc 95 ed1)))
            (setq cn (cdr (assoc 96 ed1)))
            (setq pos (vl-position (assoc 40 ed1) ed1))
            (repeat kn
               (setq knot-list (cons (cons 40 (cdr (nth pos ed1))) knot-list))
               (setq pos (1+ pos))
            )
            (setq pos (vl-position (assoc 10 ed1) ed1))
            (repeat cn
               (setq controlpoint-list (cons (cons 10 (trans (cdr (nth pos ed1)) ent 0) ) controlpoint-

list));;add trans by xiaocai
               (setq pos (1+ pos))
            )
            (setq knot-list (reverse knot-list))
            (setq controlpoint-list (reverse controlpoint-list))
            (setq ne (append
                           (list '(0 . "SPLINE"))
                           (list (cons 100 "AcDbEntity"))
                           (list (cons 100 "AcDbSpline"))
                           (list (cons 70 (+ 1 8 (* 2 (cdr (assoc 74 ed1))) (* 4 (cdr (assoc 73 ed1))))))
                           (list (cons 71 (cdr (assoc 94 ed1))))
                           (list (cons 72 kn))
                           (list (cons 73 cn))
                           knot-list
                           controlpoint-list
                  )
            )
            (if hl (setq ne (append ne (cons 8 layer))))
            (entmake ne)
            (setq ed1 (member (assoc 10 ed1) ed1))
            (setq lwp nil)
            )
         ) ; end cond
         ) ; end repeat noe
         (if lwp (progn
         (setq en1 (entnext lastent))
         (setq ss (ssadd))
         (ssadd en1 ss)
         (while (setq en2 (entnext en1))
            (ssadd en2 ss)
            (setq en1 en2)
         )
         (if (= (getvar "peditaccept") 1)
            (command "_.pedit" (entlast) "_J" ss "" "")
            (command "_.pedit" (entlast) "_Y" "_J" ss "" "")
         )
      ))

      ) ; end t
      ) ; end cond
;       Tries to get the area on islands but it's not clear how to know if an island is filled or not
;       and if it should be substracted or added to the total area.
;       (if (or (= bot 0) (= (boole 1 bot 1) 1)) (setq area (+ area (areaOfObject (entlast)))))
;       (if (and (/= hst 1) (/= bot 0) (= (boole 1 bot 1) 0)) (setq area (- area (areaOfObject (entlast)))))
;       (princ "\n") (princ bot) (princ "\n") (princ hst) (princ "\n")
;       (princ (areaOfObject (entlast)))
   ) ; end repeat loops1
   (if (and (= noarea nil) (= loops1 1)) (setq area (+ area (areaOfObject (entlast)))) (setq bMoreLoops T))
   (setq i (1+ i))
)
)
  )
  (setq ss2 nil)
  (if (and area (not bMoreLoops)) (progn
(princ "\nTotal Area = ")
(princ area)
  ))
  (restore)
  (princ)
){\rtf1}

(defun C:BN ()
  (princ "\nAdd block name to drawing.")
  (setq pt(cadr(entsel"\nSelect Block:")))
  (setq e1(ssget pt))
  (setq e2 (entget (ssname e1 0)))
  (setq blname (cdr(assoc 2 e2)))
  (setq pt1 (getpoint"\nSelect point for block title:"))
  (command "text" "c" pt1 "" blname))
(princ "\nType BN to execute)
�32

Tài khoản		Ghi nhớ?	Quên mật khẩu
Mật khẩu			Đăng ký

AutoLISP AutoCAD kts. Trần Ngọc Thắng TỰ BIÊN SOẠN + SƯU TẦM

Diễn đàn đã xem