Topic: legend make

[dussla]

hello . freind
i need some help  , pls can you help me again .
i found this image
that is legend image


work process

 0. select  entries
1. each layer entries  are  region object  or closed polyines

2. if i run lisp , that make table legend like  below image     
    sort is   area size       
     
   layer color boxs   /    layer name  /  area       



can you understand ?

[Jimmy D]

Hi,

Could this be of any help to you? (needs error checking, adjusting txt height, etc...)

(defun c:Legend ( / OldOsmode SP TP1 TP2 ss lay lay_name lay_color i Total_Area
                    ose SP1 SP2 SP3 SP4 SP5)
(if (= (getvar "DIMSCALE") 0)(setvar "DIMSCALE" 1))
(setq OldOsmode (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq SP (getpoint "\nSelect Point For Legend..."))
(setq TP1 (list (+ (car SP) 30)(cadr SP))
      TP2 (list (+ (car SP) 80)(cadr SP))
)
(setq ss (ssget '((0 . "LWPOLYLINE,REGION")(70 . 1))))
(command "-text" SP "5" "0" "Color" )
(command "-text" TP1 "5" "0" "Layer Name" )
(command "-text" TP2 "5" "0" "Area" )
(vlax-for lay (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object)))
   (setq lay_Name (vla-get-Name lay))
   (setq Lay_Color (vla-get-Color Lay))
   (setq i 0)
   (setq Total_Area 0)
      (while (/= (ssname ss i) nil)
          (setq ose (vlax-ename->vla-object (ssname ss i)))
          (if (= Lay_Name (vla-get-layer ose))(setq Total_Area (+ Total_Area (vla-get-area ose))))
      (setq i (+ i 1))
      );end while
      (if (> Total_Area 0)(progn
      (setq SP (list (car SP)(- (cadr SP) 15))
            SP1 (list (car SP)(+ (cadr SP) 10))
            SP2 (list (+ (car SP) 10)(cadr SP))
            SP3 (list (+ (car SP) 10)(+ (cadr SP) 10))
            SP4 (list (+ (car SP) 30)(+ (cadr SP) 2))
            SP5 (list (+ (car SP) 80)(+ (cadr SP) 2))
       )
       (command "solid" SP SP1 SP2 SP3 "")
       (command "change" (entlast) "" "p" "c" Lay_Color "")
       (command "-text" SP4 "" "0"  Lay_Name)
       (command "-text" SP5 "" "0"  Total_Area)
   ));end if end progn
);end vlax-for
(setvar "OSMODE" OldOsmode)
(princ)
)

Jimmy

[Andrea]

Hi,..this one is an example based on the Solid Hatch..(if there have boudary)

Code: [Select]

(defun c:allregion (/ ss1 hc cp tz sp spq23 arealist qty v sp spq1 spq2 spq3 spq4)

(setq ss1 (ssget "X" '(
       (0 . "HATCH")
       (2 . "SOLID")
      )
)
)
(setq arealist nil)
  (if ss1
    (progn
      (setq v (1- (setq qty (sslength ss1))))
      (repeat qty
(setq ss2 (ssname ss1 v))
(setq 10plist nil)
(setq hatchent (entget ss2))
(setq cp (assoc 10 (reverse hatchent)))
(setq hc (assoc 62 hatchent))
(if hc (setq hc (cdr hc))(setq hc 7))
(if cp
  (progn
  (vl-cmdf "._-boundary" "_A" "_I" "_Y" "_O" "_P" "" (cdr cp) "")
  (vl-cmdf "_area" "_O" (entlast))
  (setq arealist (append arealist (list (list (getvar "area") hc))))
)    
      )
(setq v (1- v))
    )
  )
)

(defun dtr (a)
(* pi (/ a 180.0))
)
 
(if arealist
  (progn
    (setq tz (getvar "textsize"))
    (setq sp (getpoint "select Text point"))
    (if sp
      (progn
(vl-cmdf "._text" sp "" "" "Color     Area" "")
(foreach n arealist
  (setq spq1 (polar sp (dtr 270) tz))
  (setq spq2 (polar spq1 (dtr 0) (* tz 4)))
  (setq spq3 (polar spq2 (dtr 270) (* tz 3)))
  (setq spq4 (polar spq1 (dtr 270) (* tz 3)))
  (setq spq23(polar spq2 (dtr 270) (* tz 1.5)))
  (setq spq5 (polar spq23 (dtr 0) (* tz 5)))  
  (vl-cmdf "._solid" spq1 spq2 spq4 spq3 "")
  (vl-cmdf "_chprop" (entlast) "" "_co" (nth 1 n) "")
  (vl-cmdf "._text" "_J" "_ML" spq5 "" "" (rtos (nth 0 n) 2 6) "")
  (setq sp spq4)
  )
)
      )
    )
  )
  )
     
or making a filter like...

Code: [Select]

(setq ss1 (ssget "X" '(
       (0 . "LWPOLYLINE,REGION")
       
      )
)
)