[编程交流] 使用块属性值

;;;OriginalAuthor: Pedro Miguel da Silva Ferreira    Email:pedro_ferreira@netcabo.pt
;;;Web page: http:pwp.netcabo.pt/pedro_ferreira
;;;Location: Portugal, Lisboa
;;;Modified by Wizman 06NOV08
;;;***This version works for Blocks having attribute***
(defun c:PMSFptwtxt (/
            *modelspace*
            aup_ini
            cmd_ini
            counter
            diz_ini
            edg_ini
            fla_ini
            letxt
            lun_ini
            ort_ini
            osm_ini
            plt_ini
            txt
            txtent
            txtx
            txty
            txtz
            uni_ini
            xyz
           )
   (vl-load-com)
   (defun W1 (w1_ent / blk_tag enam eobj)
   (vl-load-com)
   (setq enam w1_ent)
   (setq eobj (vlax-ename->vla-object enam))
   (setq blk_tag w1_tagname)
   (setq txtz nil)
   (if (= (vla-get-hasattributes eobj) :vlax-true)
       (progn
       (foreach n (vlax-safearray->list
                  (variant-value
                  (vla-getattributes eobj)
                  ) ;_ end_variant-value
              ) ;_ end_vlax-safearray->list
           (if    (= (strcase (vla-get-tagstring n))
              (strcase blk_tag)
           ) ;_ end_=
           (if (numberp (read (vla-get-TextString n)))
               (setq txtz (atof (vla-get-TextString n)))
           ) ;_ end_if
           ) ;_ end_if
       ) ;_ end_foreach
       ) ;_ end_progn
   ) ;_ end_if
   ) ;_ end_defun
;;;
;;;-------------------;;;
   (defun inivar ()
   (setq cmd_ini (getvar "cmdecho")
         fla_ini (getvar "flatland")
         osm_ini (getvar "osmode")
         ort_ini (getvar "orthomode")
         plt_ini (getvar "plinetype")
         aup_ini (getvar "auprec")
         uni_ini (getvar "unitmode")
         lun_ini (getvar "lunits")
         diz_ini (getvar "dimzin")
         edg_ini (getvar "edgemode")
   ) ;_ end_setq
   (setvar "CMDECHO" 0)
   (setvar "FLATLAND" 0)
   (setvar "OSMODE" 0)
   (setvar "ORTHOMODE" 0)
   (setvar "PLINETYPE" 2)
   (setvar "AUPREC" 0)
   (setvar "UNITMODE" 1)
   (setvar "LUNITS" 2)
   (setvar "DIMZIN" 0)
   (setvar "EDGEMODE" 1)
   ) ;_ end_defun
;;;
;;;Convert a list of reals into strings
   (defun linhaxy (px)
   (vl-princ-to-string px)
   ) ;_ end_defun
   (inivar)
;;;-------------------;;;
   (defun recvar ()
   (setvar "CMDECHO" cmd_ini)
   (setvar "FLATLAND" fla_ini)
   (setvar "OSMODE" osm_ini)
   (setvar "ORTHOMODE" ort_ini)
   (setvar "PLINETYPE" plt_ini)
   (setvar "AUPREC" aup_ini)
   (setvar "UNITMODE" uni_ini)
   (setvar "LUNITS" lun_ini)
   (setvar "DIMZIN" diz_ini)
   (setvar "EDGEMODE" edg_ini)
   ) ;_ end_defun
   (command "layer"
        "make"
        "PMSFptwtxt-3dpoints"
        "COLOR"
        "1"
        ""
        ""
   ) ;_ end_command
   (setq w1_tagname
        (getstring
        "\n>>>...Enter Tag name of attribute...>>>: "
        ) ;_ end_getstring
   ) ;_ end_setq
   (setq *modelspace*
        (vla-get-modelspace
        (vla-get-activedocument (vlax-get-acad-object))
        ) ;_ end_vla-get-modelspace
   ) ;_ end_setq
   (setq txt (ssget '((0 . "INSERT"))))
   (setq letxt (sslength txt))
   (setq counter 0)
   (while (< counter letxt)
   (progn
       (w1 (ssname txt counter))
       (setq txtent (entget (ssname txt counter)))
       (setq txtx (car (cdr (assoc 10 txtent))))
       (setq txty (cadr (cdr (assoc 10 txtent))))
       (setq xyz (list txtx txty txtz))
       (command "layer" "set" "PMSFptwtxt-3dpoints" "")
       (command "point" xyz)
   ) ;_ end_progn
   (setq counter (1+ counter))
   ) ;_ end_while
;;;
   (recvar)
;;;
   (command "layer" "set" "0" "")
   (princ)
) ;_ end_defun
(alert
   "Type PMSFptwtxt and press enter to run\n\n            *Author: Pedro Ferreira*"
) ;_ end_alert