增强版的插入块属性提取

autolisp

;;;本程序需以Attrib.lsp命名并存放于ACAD的搜索目录下，同时在该目录下建立DCL子目录

(defun c:ATTRIB        (/          path_F   len_path path     s              se
                 s_type          s_handent            s_name   s_insp   s_scalX
                 s_scalY  s_scalZ  NValue   CLR             CHAND    CWHAT
                )
  (setq path_F (findfile "ATTRIB.lsp"))
  (setq len_path (strlen path_F))
  (setq path_F (substr path_F 1 (- len_path (strlen "ATTRIB.LSP"))))
  (PRINC PATH_F)
  (setq s (entsel))
  (setq se (entget (car s)))
  (setq s_type (cdr (assoc 0 se)))
  (setq s_handent (cdr (assoc 5 se)))
  (if (= s_type "INSERT")
    (progn
      (setq s_name (cdr (assoc 2 se)))
      (setq s_insp (cdr (assoc 10 se)))
      (setq s_scalX (cdr (assoc 41 se)))
      (setq s_scalY (cdr (assoc 42 se)))
      (setq s_scalZ (cdr (assoc 43 se)))
    )
    (progn
      (setq s_name nil)
      (setq s_insp nil)
      (setq s_scalX nil)
      (setq s_scalY nil)
      (setq s_scalZ nil)
    )
  )
;;;  (print s_type)
;;;  (print s_handent)
;;;  (print s_name)
;;;  (mapcar 'print
;;;          (list        s_type s_handent s_name        s_insp s_scalX s_scalY s_scalZ)
;;;  )

  (NEWDCL)
  (MAINDIALOG s_name)
  (if (= CWHAT 1)
    (CHANGEVALUE CHAND NValue)
  )
  (if (= CWHAT 62)
    (CHANGECOLOR CHAND CLR)
  )

)

(defun MAINDIALOG (CAPTION / dlgId do_what selpoint eValue)
  (setq dlgId (load_dialog (strcat path_F "DCL/ATTRIB.DCL")))
  (if (> dlgId 0)
    (progn
      (setq do_what 3)
      (setq selpoint nil)
      (while (> do_what 1)
        (new_dialog "MAIN" dlgId)
        (set_tile "MAIN" CAPTION)
        (SETVALUE s_handent)
        (OnClick s_handent)
        (if (/= nil selpoint)
          (progn
            (set_tile (strcat "X" CHAND) (rtos (car selpoint)))
            (set_tile (strcat "Y" CHAND) (rtos (cadr selpoint)))
            (set_tile (strcat "Z" CHAND) (rtos (caddr selpoint)))
          )
        )
        (setq do_what (start_dialog))
        (cond
          ((= do_what 2) (unload_dialog dialog_id))
          (
           (= do_what 3)
           (CHANGEPOSITION CHAND BP)
          )
        )
      )
    )
    (setq do_what 0)
  )
)

(defun SETVALUE        (HAND / e etype eP ePX ePY ePZ evalue ecolor)
  (setq HAND (H+1 HAND))
  (setq e (entget (HANDENT HAND)))
  (setq etype (cdr (assoc 0 e)))
  (while (= etype "ATTRIB")
    (setq evalue (cdr (assoc 1 e)))
    (setq ecolor (cdr (assoc 62 e)))
    (setq eP  (cdr (assoc 10 e))
          ePX (car eP)
          ePY (cadr eP)
          ePZ (caddr eP)
    )
    (set_tile (strcat "txt" HAND) evalue)
    (set_tile (strcat "X" HAND) (rtos ePX))
    (set_tile (strcat "Y" HAND) (rtos ePY))
    (set_tile (strcat "Z" HAND) (rtos ePZ))
    (if(/= nil ecolor)
    (FILLIMAGE (strcat "clr" HAND) ecolor)
      )
;;;    (set_tile (strcat "clr" HAND) (rtos ecolor))
    (setq HAND (H+1 HAND))
    (setq e (entget (HANDENT HAND)))
    (setq etype (cdr (assoc 0 e)))
  )
)
(defun FILLIMAGE (strKey COLOR / x y)
  (setq x (dimx_tile strKey))
  (setq y (dimy_tile strKey))
  (start_image strKey)
  (fill_image 0 0 x y COLOR)
  (end_image)
  (setq COLOR COLOR)
)

(defun OnClick (HAND / e etype eP ePX ePY ePZ evalue ecolor)
  (setq HAND (H+1 HAND))
  (setq e (entget (HANDENT HAND)))
  (setq etype (cdr (assoc 0 e)))
  (while (= etype "ATTRIB")
    (setq evalue (cdr (assoc 1 e)))
    (setq eP  (cdr (assoc 10 e))
          ePX (car eP)
          ePY (cadr eP)
          ePZ (caddr eP)
    )
    (setq ecolor (cdr (assoc 62 e)))
    (action_tile
      (strcat "txt" HAND)
      (strcat "(progn(setq CHAND \""
              HAND
              "\"  CWHAT 1)(setq NValue $value))"
      )
    )
    (action_tile
      (strcat "cmd" HAND)
      (strcat "(progn(setq BP (list "
              (rtos ePX)
              " "
              (rtos ePY)
              " "
              (rtos ePZ)
              "))(setq CHAND \""
              HAND
              "\" CWHAT 10)(done_dialog 3))"
      )
    )
    (if(/= nil ecolor)
    (action_tile
      (strcat "clr" HAND)
      (strcat "(progn(setq CHAND \""
              HAND
              "\" CWHAT 62)"
              "(setq CLR(FILLIMAGE \"clr"
              HAND
              "\" (acad_colordlg "
              (rtos ecolor)
              "))"
              ")"
              ")"
      )
    )
      )
;;;    (FILLIMAGE (strcat "clr" HAND) CCLR)
;;;    (set_tile (strcat "clr"   HAND) (rtos 14))
    (setq HAND (H+1 HAND))
    (setq e (entget (HANDENT HAND)))
    (setq etype (cdr (assoc 0 e)))
  )
)

(defun CHANGEPOSITION (HAND P0 / e elist)
  (setq selpoint (getpoint P0 (strcat HAND "请选择插入点：")))
  (setq e (handent HAND))
  (setq elist (entget e))
  (setq
    elist (subst (append (list 10) selpoint) (assoc 10 elist) elist)
  )
  (setq
    elist (subst (append (list 11) selpoint) (assoc 11 elist) elist)
  )
  (entmod elist)
  (entupd e)
)
(defun CHANGEVALUE (HAND VALUE / e elist)
  (setq e (handent HAND))
  (setq elist (entget e))
  (setq
    elist (subst (cons 1 VALUE) (assoc 1 elist) elist)
  )
  (entmod elist)
  (entupd e)
)

(defun CHANGECOLOR (HAND CLR / e elist)
  (setq e (handent HAND))
  (setq elist (entget e))
  (setq
    elist (subst (cons 62 CLR) (assoc 62 elist) elist)
  )
  (entmod elist)
  (entupd e)
)

;;;********************************
;;;* 创建对话框                   *
;;;********************************

(defun NEWDCL ()
  (setq Fn (open (strcat path_F "DCL/ATTRIB.DCL") "w"))

  (write-line "MAIN:dialog{" Fn)
  (write-line "key=\"MAIN\";" Fn)
  (ADDROW s_handent)
  (write-line ":text{" Fn)
  (write-line "key=\"test\";" Fn)
  (write-line "value=\"test\";" Fn)
  (write-line "}" Fn)
  (progn
    (write-line ":row{" Fn)
    (write-line "fixed_width=true;" Fn)
    (write-line ":ok_button{" Fn)
    (write-line "key=\"OK_BUTTON\";" Fn)
    (write-line "}" Fn)
    (write-line ":cancel_button{" Fn)
    (write-line "key=\"CANCEL_BUTTON\";" Fn)
    (write-line "}" Fn)
    (write-line "}" Fn)
  )
  (write-line "}" Fn)
  (close Fn)
)

(defun DCLROW (HAND CAPTION VALUE / Ln)
  (write-line ":row{" Fn)
  (write-line "alignment=right;fixed_width=true;" Fn)
  (progn
    (write-line ":edit_box{" Fn)
    (write-line "alignment=right;edit_width=30;" Fn)
    (write-line (strcat "key=\"txt" HAND "\";") Fn)
    (write-line (strcat "label=\"" CAPTION "\";") Fn)
    (write-line "}" Fn)
  )
  (progn
    (write-line ":button{" Fn)
    (write-line (strcat "key=\"cmd" HAND "\";") Fn)
    (write-line "fixed_width=true;" Fn)
    (write-line (strcat "label=\"" HAND "\";") Fn)
    (write-line "}" Fn)
  )
  (if(/= nil (assoc 62 (entget(handent HAND))))
    (progn
  (write-line ":image_button{" Fn)
  (write-line "width=3;heigth=2;" Fn)
  (write-line (strcat "key=\"clr" HAND "\";") Fn)
  (write-line "}" Fn)
  ))
  (COORDINATE "X" HAND Fn)
  (COORDINATE "Y" HAND Fn)
  (COORDINATE "Z" HAND Fn)
  (write-line "}" Fn)
)

(defun COORDINATE (DIM HAND Fn)
  (write-line ":edit_box{" Fn)
  (write-line "alignment=right;edit_width=5;" Fn)
  (write-line (strcat "key=\"" DIM HAND "\";") Fn)
  (write-line (strcat "label=\"" DIM ":\";") Fn)
  (write-line "}" Fn)
)

(defun ADDROW (HAND / e etype ename eVALUE)
  (setq HAND (H+1 HAND))
  (setq e (entget (HANDENT HAND)))
  (setq etype (cdr (assoc 0 e)))
  (while (= etype "ATTRIB")
    (progn
      (setq ename (cdr (assoc 2 e)))
      (setq eVALUE (cdr (assoc 1 e)))
      (DCLROW HAND ename eVALUE)
    )
    (setq HAND (H+1 HAND))
    (setq e (entget (HANDENT HAND)))
    (setq etype (cdr (assoc 0 e)))
  )
)

;;; *************************************************************
;;; *  程序(H+1 字符形式的16进制数)可以将任意字符形式的16进制数 *
;;; *  加1后返回，返回值仍为字符形式的16进制数。                *
;;; *************************************************************

(defun H+1 (N0 / i lenN0)
  (setq        strHex (list "0"   "1"         "2"   "3"   "4"   "5"         "6"   "7"
                     "8"   "9"         "A"   "B"   "C"   "D"         "E"   "F"
                    )
  )
  (setq lenN0 (strlen N0))
  (setq i lenN0)
  (while (> i 0)
    (set (read (strcat "strN0[" (rtos i) "]")) (substr N0 i 1))
    (setq ascN0 (ascii (substr N0 i 1)))
    (setq quo8 (fix (/ ascN0 8)))
    (setq res8 (- ascN0 (* quo8 8)))
    (if        (< quo8 7)
      (set (read (strcat "N0[" (rtos i) "]")) res8)
      (if (= quo8 7)
        (set (read (strcat "N0[" (rtos i) "]")) (+ 8 res8))
        (set (read (strcat "N0[" (rtos i) "]")) (+ 9 res8))
      )
    )
    (set (read (strcat "CARRY[" (rtos (+ lenN0 1)) "]")) 0)
    (if        (= i lenN0)
      (set (read (strcat "N0[" (rtos i) "]"))
           (+ 1 (eval (read (strcat "N0[" (rtos i) "]"))))
      )
      (set (read (strcat "N0[" (rtos i) "]"))
           (+
             (eval (read (strcat "N0[" (rtos i) "]")))
             (eval (read (strcat "CARRY[" (rtos (+ i 1)) "]")))
           )
      )
    )
    (if        (<= (eval (read (strcat "N0[" (rtos i) "]"))) 15)
      (set (read (strcat "CARRY[" (rtos i) "]")) 0)
      (progn
        (set (read (strcat "CARRY[" (rtos i) "]")) 1)
        (set (read (strcat "N0[" (rtos i) "]")) 0)
      )
    )
    (setq i (- i 1))
  )
  (if (= CARRY[1] 1)
    (setq N0 "1")
    (setq N0 "")
  )

  (setq i 1)
  (while (<= i lenN0)
    (setq
      N0
       (strcat N0
               (nth (eval (read (strcat "N0[" (rtos i) "]"))) strHex)
       )
    )
    (setq i (+ i 1))
  )
  (setq N0 N0)
)

alin

it works not quite well when I press "Cancel" buttons.