[编程交流] 标记对象

;; AXD.lsp
;; set xdata
(vl-load-com)
(defun C:AXD (/ acapp adoc appname counter obj ss xtype xvalue)
 (setq acapp    (vlax-get-acad-object) 
             adoc     (vla-get-activedocument acapp)
)
 ;; define application name
 (setq appname "STEEL_ENFORCE")
 ;; register application, if this registered earlier,
 ;; just ignore it
 (vl-catch-all-apply
   (function (lambda()
        (regapp appname)))
 (alert (strcat "Select steel enforcement,\n
then enter data for them,\n
then repeat the same for next one"))
 ;;
 (setq counter 1)
 (while ; loop
   (setq ss (ssget "_+.:S:E" (list (cons 0 "*POLYLINE");|(cons 8 "M-STEEL-DETAIL")|));<==change layer name if you need it
     (progn
       (setq obj (vlax-ename->vla-object (ssname ss 0))
             xtype    (list 1001;|appname|;
                     1000;|Tendon#|;
                     1041;|length|;
                     1041;|elongation|;
                     1040;|diameter|;
                     1000;|subject|;
                     1000;|comments|;
                     1000;|title|;
                     )
      )
            (setq xvalue   (list appname
                  (strcat "Tendon_" (itoa counter))
           (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj))
           (getreal (strcat "\nEnter elongation for Tendon#"  (itoa counter) ": "))
           (getreal "\nEnter diameter: ")                  
                  (getstring T "\nEnter subject description (less than 256 characters!): ")
           (getstring T "\nEnter comments (less than 256 characters!) : ")
           (getstring T "\nEnter title : ")
  
                 ) 
       ) 
       (vlax-invoke 
         obj 
         'SetXdata 
         xType 
         xvalue 
       )
(setq counter (1+ counter))
(setq xvalue nil)
)
   )
)
(princ)
 )
(princ "\nType AXD to add xdata")
(princ)

;; XDT.lsp
;; read xdata and write it in .CSV file (comma separated)
(vl-load-com)
(defun C:XDT  (/ appname data en fdesc fn obj ss xdv)
 
 (setq appname "STEEL_ENFORCE")
 (setq fn (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".csv"))
(if (not (findfile fn))
(setq fdesc (open fn "w"))
(setq fdesc (open fn "a"))
)
 (setvar "cmdecho" 0)
 (write-line "Name,Length,Elongation,Diameter,Subject,Description,Comments,Title" fdesc)
 (setq ss (ssget "_X" (list (list -3 (list appname)))))
 (while (setq en (ssname ss 0))
   (setq obj (vlax-ename->vla-object (ssname ss 0)))
   (vla-getXdata
     obj
     appname
     'xtp
     'xdv
     )
   (setq data
   (cdr (mapcar 'vlax-variant-value
           (vlax-safearray->list xdv)
           )
        )
  )
   (ssdel en ss)
   (write-line (strcat (car data) ","
                (rtos (cadr data) 2 2) ","
                (rtos (caddr data) 2 2) ","
                (rtos (cadddr data) 2 2) ","
                (nth 4 data) ","
                (nth 5 data) ","
                (nth 6 data))
                fdesc)
   )
 (close fdesc)
 (setvar "cmdecho" 1)
 (princ)
 )
(princ "\nType XDT to write xdata to file")
(princ)