- Marcar como nuevo
- Favorito
- Suscribir
- Silenciar
- Suscribirse a un feed RSS
- Resaltar
- Imprimir
- Denunciar
I have a lisp routine that will get me the acreage of a closed polygon and set the acreage text. I would like to know if there is a way to edit this code so that the text is associative with the polygon?
If my polygon is 10 ac and I run my lisp it will put the text "10 ac" but if I were to scale that polygon, the text still remains at "10 ac". I would like to scale my polygon after the fact and have my text(ac) automatically update as well.
Any and all help is appreciated
(defun C:SQA ()(C:SQACRE))
(defun C:ac (/ CLAY CHOOSE ARTOTAL ARLIST GO AR LBLHT LABEL_TEXT
TABLELIST
TXLIST
TXT_PNT)
(setvar "cmdecho" 0)
(setvar "cmddia" 0)
(prompt "\nSQACRE or SQA")
(setq CLAY (getvar "clayer")) ;_get current layer
(prompt "\nSQA calculates square acres.")
(setq LBLHT (getreal "\nEnter height for area labels: "))
;;;This function creates multi-text.
(defun AREA_LABEL (/ TXT_PNT)
(setvar "clayer" "Area_Labels") ;_set current layer to calls
(setq TXT_PNT (getpoint "\nEnter point for label: "))
(entmake
(list
(cons 0 "MTEXT")
(cons 100 "AcDbEntity")
(cons 8 "Area_Labels") ;_layer
(cons 62 7) ;_text color 7=(white)
(cons 100 "AcDbMText") ;_object type
(cons 10 TXT_PNT) ;_start point of text
(cons 40 LBLHT) ;_height of text
(cons 71 5) ;_attachment point, 5=Middle center
(cons 72 1) ;_direction, 1=Left to right
(cons 1 (strcat (rtos AR 2 2) " ACRES")) ;_the text string
(cons 7 "Area_Labels") ;_text style name
(cons 50 0.0) ;_rotation angle in radians
) ;end entity list
) ;_entmake
(setq LABEL_TEXT (entlast))
(princ)
) ;_end AREA_LABEL function
;;;--------------------------------------------------------------------------------------
(if (not (tblsearch "layer" "Area_Labels"))
(progn
(entmake
(list
'(0 . "LAYER")
'(5 . "28")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(2 . "Area_Labels")
'(70 . 64)
'(62 . 250) ;_layer color white
'(6 . "CONTINUOUS")
))))
(defun GETAREA (/)
(command "area" "Object" pause)
(setq AR (getvar "area")) ;_get the area returned by getvar variable
(setq AR (/ AR 43560.00)) ;_divide square inches by 43560 sq.ft.(1 Acre)
(princ)
) ;_end defun GETAREA
(initget "Single Multiple")
(setq CHOOSE (getkword "\nArea [Single/Multiple]: "))
(cond
((= CHOOSE "Multiple")
(princ "\nSelect objects:")
(GETAREA)
(AREA_LABEL)
(setq ARLIST (append ARLIST (list AR)))
(setq GO "Next")
(while
(= GO "Next")
(initget "Done Next")
(setq GO (getkword "\nNext/Done <Done>: "))
(if (= GO nil)(setq GO "Done"))
(cond
((= GO "Next")
(princ "\nSelect objects:")
(GETAREA)
(AREA_LABEL)
(setq ARLIST (append ARLIST (list AR))) ;_add area to list
)
((= GO "Done")
(prompt "\n--- F2: LIST OF AREAS & TOTAL. ---")
)
) ;_end conditions
) ;_end while
(setq ARTOTAL (apply '+ ARLIST)) ;_add the areas together
(setq Num 1)
(foreach x ARLIST ;_for each area in the list
(setq TABLELIST (append TABLELIST (list
(strcat
"\n"
"Area "
(rtos Num 2 0) ;_number each one
"."
" "
"\t" "\t"
(rtos X) ;_make area a string
)
)))
(setq Num (1+ Num))
) ;_end foreach
(setq TXLIST (nth 0 TABLELIST)) ;_set variable to 1st string in list
(setq TABLELIST (cdr TABLELIST)) ;_reset list to all but the first string
(foreach X TABLELIST
(setq TXLIST (strcat TXLIST X)) ;_make a list of all strings from TLIST
)
(setq TABLEHEADER (strcat "PARCEL" "\t" "\t" "ACRES"))
(princ TXLIST)
(princ (strcat "\nTotal Acres = " (rtos ARTOTAL 2 2))) ;_ print to the text window
(setq TXT_PNT (getpoint "\nEnter point for Area Table: "))
(entmake
(list
(cons 0 "MTEXT")
(cons 100 "AcDbEntity")
(cons 8 "Area_Labels") ;_layer
(cons 62 7) ;_text color 7=(white)
(cons 100 "AcDbMText") ;_object type
(cons 10 TXT_PNT) ;_start point of text
(cons 40 LBLHT) ;_height of text
;(cons 71 5) ;_attachment point, 5=Middle center
(cons 71 1) ;_attachment point, 1=Top Left
(cons 72 1) ;_direction, 1=Left to right
(cons 1 (strcat TABLEHEADER
"\n" TXLIST
"\nTotal Acres = " "\t" (rtos ARTOTAL 2 2)
)
) ;_the text string
(cons 7 "Area_Labels") ;_text style name
(cons 50 0.0) ;_rotation angle in radians
) ;end entity list
) ;_entmake
) ;_end = CHOOSE "Multiple"
((= CHOOSE "Single")
(princ "\nSelect object:")
(GETAREA)
(AREA_LABEL)
(princ (strcat "\n" (rtos AR 2 2) " Acres")) ;_ print area of single object
)
) ;end conditions
(setvar "clayer" CLAY) ;_reset current layer
(princ)
) ;_end SQACRE
¡Resuelto! Ir a solución.