请大家帮个忙啊！！！

zyxfu

能看看这个程序为什么不通吗？？好象是DCL有问题啊！！！谢谢！！！

提取插入块的属性！！！！

;;;本程序需以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)
)

meflying

将DCL/ATTRIB.DCL中的DCL/去掉，程序可以正确运行。

但程序有些问题，取出块的属性时，用句柄来找出属性对象时，紧跟INSERT对象的是SEQEND，所以第一个H+1处应该加2，
为什么不用entnext?
其它的未细看，现在程序等于没有任何用处