请教各位高手 （有关已插入块的属性提取） 急急急急救！！！！

hys_han

各位高手大家好，能在这里跟大家交流很荣幸！！
    有个问题向大家请教：我现在在编一个大批量提取特定点（或图块）的点坐标（主要是“Z”）的lisp程序，可是这些点的“Z”坐标（高程值）为零，这些 Z 值隐含在其附近“dhgh”块的属性“H”里了，我用了很多方法（如 entget等）想实现获取“H”的属性值，可是都没能成功。
    请各位高手赐教！！！
    多谢多谢

陈伯雄

·  以块图形为索引的非图形数据
以一个两位三通阀为例：关于这个阀的图形很容易绘制，那些有关的设计参数，如：压力、流量、中位机能代号、控制方式代号等，就是属于非图形数据。而且必须与阀的图形数据捆在一起，并要求能从阀的图形开始检索。
使用块结合属性的技术方法，可以把这些信息一一定义成不显示的属性值，再用块的生成命令把阀的图形与这些有关属性一起作成一个块，就制成了一个以图形为索引的非图形数据单元。
向液压原理图中插入上述块时，AutoCAD会要求填写有关的非图形数据。可根据插入时关于属性值的提示，键入设计参数，就会被记在该图形文件当中。用一个简单的 AutoLISP 对象数据库访问程序，就可在你用光标指定某个阀的图形后，快速提取出相关的非图形数据。如果有相当完整的功能模块，可能完全不用笔，纸和设计手册，完成相当随意的液压设计。各组件间的设计参数的传递，全用有关的非图形数据库单元完成。
例如做了一些块，其中包含若干属性，定义过程如下：
命令: -attdef
当前属性模式: 不可见=N  固定=N  验证=N  预置=N
输入要修改的选项 [不可见(I)/固定(C)/验证(V)/预置(P)] <完成>: i
当前属性模式: 不可见=Y  固定=N  验证=N  预置=N
输入要修改的选项 [不可见(I)/固定(C)/验证(V)/预置(P)] <完成>:
输入属性标记名: 型号
输入属性提示: 型号
输入缺省属性值: A01
命令:
-ATTDEF
当前属性模式: 不可见=Y  固定=N  验证=N  预置=N
输入要修改的选项 [不可见(I)/固定(C)/验证(V)/预置(P)] <完成>:
输入属性标记名: 数量
输入属性提示: 数量

输入缺省属性值: 2
当前文字样式:  工程字  文字高度:  5.0000
指定文字的起点或 [对正(J)/样式(S)]:

用下面的模拟程序就能够提取指定块的属性数据 (T505.LSP) ：
(Defun C:SBlockA ()
           (SetQ bn (Car (EntSel "\n指定带属性的块: ")))
           (If (Assoc 66 (EntGet bn))
                     (Progn (SetQ bn (EntNext bn)
                                     bl (EntGet bn)
                         )
                                 (While (= "ATTRIB" (Cdr (Assoc 0 bl)))
                                      (Alert (StrCat "属性名: " (Cdr (Assoc 2 bl))
                                                                 "\n属性值: " (Cdr (Assoc 1 bl))
                                                         )
                                             )
                                      (SetQ bl (EntGet (SetQ bn (EntNext bn))))
                         )
                    )  
                    (Alert "没有属性...")
            )
)

摘自《Visual LISP程序设计——技巧与范例》

hys_han

您的回复很好，非常感谢您的赐教！！！
      

Ea

http://www.mjtd.com/function/list.asp?id=188&ordertype=byletter

autolisp

;;;使用本程序前请在AutoCAD的搜索目录里建一个子目录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)
)

autolisp

本程序(c:attrib)需以Attrib.lsp命名,并且要在ACAD的搜索目录下，同时要在ACAD的搜索目录下建立DCL子目录

hys_han

autolisp大哥：
    非常感谢您的帮助，您的程序对我的启发很大，谢谢！！！