[编程交流] 标记对象#039；s层使用

(defun c:ObjLayer(/ pnt1 pnt2 n obj dxf LayerName newdxf)
 (setq n 1)
 (while (> n 0)
   (setq pnt1 (getpoint "\nPick first point:"))
   (setq pnt2 (getpoint pnt1 "\nPick next point:"))
   (setq obj (car (entsel "\nPick Entity:")))
   (setq dxf (entget obj))
   (setq LayerName (cdr (assoc 8 dxf)))
   (setq newdxf '((0 . "MULTILEADER")
             (cons 110 (car pnt1)(cadr pnt1)(caddr pnt1))
             (cons 10 (car pnt2)(cadr pnt2)(caddr pnt2))
             (cons 304 LayerName)
             (cons 8 "A-ANNO-DIMS")
             ))
   (entmake newdxf)
   (setq n (1+ n))
 )
)

(defun c:Test (/ spc p1 p2 str lead)
 (vl-load-com)
 ;; Tharwat 08. 07. 2011
 (cond ((not acdoc)
        (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
       )
 )
 (setq spc (if (> (vla-get-activespace acdoc) 0)
             (vla-get-modelspace acdoc)
             (vla-get-paperspace acdoc)
           )
 )
 (while
   (and
     (setq p1 (getpoint "\n specify First Point :"))
     (setq p2 (getpoint p1 "\n Specify Second point :"))
     (setq str
            (car (entsel "\n Specify any entity to get its Layer name :"))
     )
   )
    (progn
      (setq lead (vla-addmleader
                   spc
                   (vlax-make-variant
                     (vlax-safearray-fill
                       (safearray vlax-vbdouble '(0 . 5))
                       (apply 'append (list p1 p2))
                     )
                   )
                   0
                 )
      )
      (vla-put-textstring lead (cdr (assoc 8 (entget str))))
    )
 )
 (princ)
)

(apply 'append (list '(a b c) '(d e f)))  =  (a b c d e f)  =  (append '(a b c) '(d e f))

[color=GREEN];; Object Layer in MLeader Field  -  Lee Mac  -  www.lee-mac.com[/color]
([color=BLUE]defun[/color] c:layerleader ( [color=BLUE]/[/color] _getpoints _objectid acdoc e l )
   ([color=BLUE]setq[/color] acdoc ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))
   ([color=BLUE]setq[/color] _getpoints
       ([color=BLUE]lambda[/color] ( [color=BLUE]/[/color] l p )
           ([color=BLUE]if[/color] ([color=BLUE]car[/color] ([color=BLUE]setq[/color] l ([color=BLUE]list[/color] ([color=BLUE]getpoint[/color] [color=MAROON]"\nFirst Point: "[/color]))))
               ([color=BLUE]while[/color] ([color=BLUE]setq[/color] p ([color=BLUE]getpoint[/color] [color=MAROON]"\nNext Point <Done>: "[/color] ([color=BLUE]car[/color] l)))
                   ([color=BLUE]mapcar[/color]
                      '([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]grdraw[/color] a b 3 1))
                       ([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] p l))
                       ([color=BLUE]cdr[/color] l)
                   )
               )
           )
           ([color=BLUE]redraw[/color]) ([color=BLUE]reverse[/color] l)
       )
   )
   ([color=BLUE]setq[/color] _objectid
       ([color=BLUE]eval[/color]
           ([color=BLUE]list[/color] '[color=BLUE]lambda[/color] '( obj )
               ([color=BLUE]if[/color]
                   ([color=BLUE]and[/color]
                       ([color=BLUE]vl-string-search[/color] [color=MAROON]"64"[/color] ([color=BLUE]getenv[/color] [color=MAROON]"PROCESSOR_ARCHITECTURE"[/color]))
                       ([color=BLUE]vlax-method-applicable-p[/color] ([color=BLUE]vla-get-utility[/color] acdoc) 'getobjectidstring)
                   )
                   ([color=BLUE]list[/color] '[color=BLUE]vla-getobjectidstring[/color] ([color=BLUE]vla-get-utility[/color] acdoc) 'obj '[color=BLUE]:vlax-false[/color])
                  '([color=BLUE]itoa[/color] ([color=BLUE]vla-get-objectid[/color] obj))
               )
           )
       )
   )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]setq[/color] e ([color=BLUE]car[/color] ([color=BLUE]entsel[/color])))
           ([color=BLUE]<[/color] 1 ([color=BLUE]length[/color] ([color=BLUE]setq[/color] l (_getpoints))))
       )
       ([color=BLUE]vla-put-textstring[/color]
           ([color=BLUE]vlax-invoke[/color]
               ([color=BLUE]vlax-get-property[/color] acdoc ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]getvar[/color] 'CVPORT)) 'paperspace 'modelspace))
               'addmleader
               ([color=BLUE]apply[/color] '[color=BLUE]append[/color] l) 0
           )
           ([color=BLUE]strcat[/color] [color=MAROON]"%<\\AcObjProp Object(%<\\_ObjId "[/color] (_objectid ([color=BLUE]vlax-ename->vla-object[/color] e)) [color=MAROON]">%).Layer>%"[/color])
       )
   )
   ([color=BLUE]vla-regen[/color] acdoc [color=BLUE]acactiveviewport[/color])
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])