[编程交流] 如何使用Att插入块

;DESCRIPTION
;
;This lisp places a block with ATTs of "AREA" and "LAYER NAME" that are filled automatically and are related to an specific polyline or hatch defined by the user.
;
;NOTES: The block and its ATTs must be defined in the drawing prior to execute this routine.
;
;Definition of the lisp and its local variables
(defun c:prueba ()
        
;Requests the user to select a polyline or hatch and stores the selection into a variable.
(setq OBJ_REF (car (entsel "\n Selecciona una polilinea o un hatch: ")))
;Shows in the command line the entity name of the selected object.
(print OBJ_REF)(terpri)
;Shows in the command line the layer name of the selected object.
(princ (strcat "\n El layer del objeto es: "(cdr (assoc 8 (entget OBJ_REF)))))
;Requests the user to select the point where the block will be inserted and stores it into a variable.
(setq INS_PNT (getpoint "\n Indica el punto de insercion del bloque:"))
;Inserts the block in the position previously indicated by the user.
(command "._insert" "MA_Tag_Areas" INS_PNT "" "" "")
;Selects the last entity inserted in the drawing and store its name into a variable.
(setq BLK_NAM (entlast))
(princ "\n El nombre del bloque es: ")(terpri)
(princ BLK_NAM)
(princ "\n ")
Obtains the DXF group doted pairs and stores it into a variable.
(setq BLK_LIST (entget BLK_NAM))
(princ "\n El contenido del bloque es: ")(terpri)
(princ BLK_LIST)
(princ "\n ")
;Avoids to finish the routine with the text "nill" shown at the command line
(princ)
)

;;   Write the area of the selected polylines in the position of   ;;
;;   maximum inscribed circle.                                     ;;
;;                                                                 ;;
;;   19.01.2013 - Gian Paolo Cattaneo                              ;;
(defun c:arpoly (/ sel poly POLY_vl Dx Dy Lp List_vert_poly list_p_int P_center dist step1 step2)
   (prompt "\nSelect Polyline: ")
   (setq sel (ssget '((0 . "LWPOLYLINE"))))
   (if sel
       (progn
           (repeat (setq :n (sslength sel))
               (setq poly (ssname sel (setq :n (1- :n))))
               (setq jjj 0)
               (setq step1 30) ;--> grid_1 density
               (setq step2 10) ;--> grid_2 density
               (setq POLY_vl (vlax-ename->vla-object POLY))
               (setq list_vert_poly (LM:LWPoly->List POLY))
               (grid_1)   
               (Point_int)
               ;(grid+) ;increase accuracy
               (Point_center)
               (if (= jjj 1) (setq p_prov P_center))
              ;(repeat 2 ;increase accuracy
                   (grid_2) 
                   (Point_center)
              
               (entmake
                   (list
                       (cons 0 "TEXT")
                       (cons 8 (getvar "clayer"))
                       (cons 7 (getvar "textstyle"))
                       (cons 10 P_center)
                       (cons 11 P_center)
                       (cons 40 (getvar "textsize"))
                       (cons 72 1)
                       (cons 73 2)
                       (cons 1 (rtos (vlax-curve-getArea poly) 2 2))
                   )
               )
           )
           (princ)
       )
       (alert "No selected lwpolyline")
   )
)        
;; LWPolyline to Point List  -  Lee Mac
;; Returns a list of points describing the supplied LWPolyline
(defun LM:LWPoly->List ( ent / der di1 di2 inc lst par rad )
   (setq par 0)
   (repeat (cdr (assoc 90 (entget ent)))
       (if (setq der (vlax-curve-getsecondderiv ent par))
           (if (equal der '(0.0 0.0 0.0) 1e-
               (setq lst (cons (vlax-curve-getpointatparam ent par) lst))
               (if
                   (setq rad (distance '(0.0 0.0) (vlax-curve-getfirstderiv ent par))
                         di1 (vlax-curve-getdistatparam ent par)
                         di2 (vlax-curve-getdistatparam ent (1+ par))
                   )
                   (progn
                       (setq inc (/ (- di2 di1) (1+ (fix (* 10 (/ (- di2 di1) rad (+ pi pi)))))))
                       (while (< di1 di2)
                           (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
                                 di1 (+ di1 inc)
                           )
                       )
                   )
               )
           )
       )
       (setq par (1+ par))
   )
   (setq x lst)
   lst
)
; Restituisce una griglia di punti all'interno del getboundingbox della poly selezionata
; Returns a grid of points within the BoundingBox of the selected poly
(defun grid_1 (/ P1_ P2_ n P> )
   (vla-getboundingbox POLY_vl 'p1 'p2)
   (setq P1_ (vlax-safearray->list p1))
   (setq P2_ (vlax-safearray->list p2))
   (setq P1_ (list (car P1_) (cadr P1_)))
   (setq P2_ (list (car P2_) (cadr P2_)))
   (setq Dx (/ (- (car P2_) (car P1_)) step1))
   (setq Dy (/ (- (cadr P2_) (cadr P1_)) step1))
   (setq n 0)
   (setq P> P1_)
   (setq Lp (list P1_))
   (repeat (* (1+ step1) step1)
       (setq P> (list (+ (car P>) Dx) (cadr P>)))
       (setq Lp (cons P> Lp))
       (setq n (1+ n))
       (if (= n step1)
           (progn
               (setq n 0)
               (setq P1_ (list (car P1_) (+ (cadr P1_) Dy)))
               (setq P> P1_)
               (setq Lp (cons P> Lp))
           )
       )
   )
   (setq Lp (cdr Lp))
   (setq a Lp)
)
  
; Restituisce una griglia di punti intorno al punto centrale (provvisorio)
; Returns a grid of points around the center point (provisional)
(defun grid_2 (/ P1_  P> n)
   (setq list_p_int nil)
   (setq P1_ (list (- (car P_center) (* Dx 2)) (- (cadr P_center) (* Dy 2))))
   (setq Dx (/ (* 4 Dx) step2))
   (setq Dy (/ (* 4 Dy) step2))
   (setq n 0)
   (setq P> P1_)
   (setq list_p_int (list P1_))
   (repeat (* (1+ step2) step2)
       (setq P> (list (+ (car P>) Dx) (cadr P>)))
       (setq list_p_int (cons P> list_p_int))
       (setq n (1+ n))
       (if (= n step2)
           (progn
               (setq n 0)
               (setq P1_ (list (car P1_) (+ (cadr P1_) Dy)))
               (setq P> P1_)
               (setq list_p_int (cons P> list_p_int))
           )
       )
   )
   (setq d  list_p_int)
)
   
; restituisce la lista dei punti interni ad un poligono
; dati:  - lista coordinate dei punti -> Lp
;        - lista coordinate vertici poligono -> list_vert_poly
; Returns the list of inside points 
(defun Point_int (/ P_distant n Pr cont attr p# Pa Pa_ Pb )
   (setq P_distant (list (car (getvar "extmax")) (* 2 (cadr (getvar "extmax")))))    
   (setq list_p_int nil)
   (foreach Pr Lp 
       (setq cont -1)
       (setq attr 0)
       (setq p# nil) 
       (setq Pa (nth (setq cont (1+ cont)) list_vert_poly))
       (setq Pa_ Pa)
       (repeat (length list_vert_poly)
           (setq Pb (nth (setq cont (1+ cont)) list_vert_poly))
           (if (= cont (length list_vert_poly)) (setq Pb Pa_))
           (setq P# (inters Pa Pb Pr P_distant))
           (if (/= P# nil) (setq attr (1+ attr)))
           (setq Pa Pb)
       )
       (if (> (rem attr 2) 0) (setq list_p_int (cons Pr list_p_int)))      
   )
   (setq b list_p_int)
)
; Infittisce la griglia inserendo altri punti
; nel centro delle diagonali tra i punti interni
; Increases the grid density
(defun grid+ (/ G+)
   (setq G+
       (mapcar '(lambda ( x ) (list (+ (car x) (/ Dx 2)) (+ (cadr x) (/ Dy 2)))) list_p_int)
   )
   (setq list_p_int (append G+ list_p_int))
   (setq c list_p_int)
)
; Da una lista di punti restituisce quello più lontano da un oggetto
; dati:  - lista dei punti -> list_p_int
;        - oggetto -> POLY_vl
; Returns the farthest point from the polyline
(defun Point_center (/ Pa n Pvic)
   (setq Dist 0.0000001)
   (setq P_center nil)
   (foreach Pa list_p_int
(setq Pvic (vlax-curve-getClosestPointTo POLY_vl Pa))
       (if (> (distance Pa Pvic) Dist)
           (progn
               (setq P_center Pa)
               (setq Dist (distance Pa Pvic))
           )
       )
   )
   (setq jjj (1+ jjj))
   (setq pc P_center)
)
(vl-load-com)
(prompt "\n ") (prompt "\n ") (prompt "\n ")
(princ "\nType "ARPOLY" to invoke")
(princ)