Area for all polylines and divide it.

[Anonymous]

Good morning Dears

I have lisp AREAON given me area for all polylines one time, and I found below code,  I added it to this lisp to divided all result by 9.1 (you can find in attached lisp GPM11.lisp), but doesn't work with all polylines only with last one in selection, can you please help me to divide all results not only last one?.

(setq bo (vlax-ename->vla-object (entlast)))
(setq n (/(atof(vlax-get bo 'TextString)) 9.1))
(vla-put-textstring bo n)

Please note: all above and other lisps I found it here, thanks for all in this good community, thanks a lot.

[ВeekeeCZ]

I don't see your AREAON lisp.

Also, post some sample dwg to illustrate the issue.

[diagodose2009]

You add this code

	(setq x	 (/ allx ctr)
	      y	 (/ ally ctr)
	      pt (list x y)
              arr2 (/ areaobj 9.1) 
              strmdll (strcat "div9=" (rtos arr2 2 precision))
	)
	(command "text" "j" "mc"
		 pt
		 (* sch 2.5)
		 "0"
strmdll
	)

You fill the TextScreen wiht TooMany because You Use Command Line.

Current text style:  "Standard"  Text height:  1.250  Annotative:  No
Specify start point of text or [Justify/Style]: j Enter an option 
[Align/Fit/Center/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR]: mc
Specify middle point of text:
Specify height <1.250>: 1.250000000000000
Specify rotation angle of text <0.0000g>: 0
Enter text: 2215.799
Command: text
Current text style:  "Standard"  Text height:  1.250  Annotative:  No
Specify start point of text or [Justify/Style]: j Enter an option 
[Align/Fit/Center/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR]: mc
Specify middle point of text:
Specify height <1.250>: 1.250000000000000
Specify rotation angle of text <0.0000g>: 0
Enter text: 1266.097
Command: _.UNDO Current settings: Auto = On, Control = All, Combine = Yes, 
Layer = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back] 
<1>: END

You must replace the (command "Layer" "make" ) wit, the function dfn_;layer_new is SelfChecking if-LayerExists

(defun dfn_layer_new(a245 coloriz on_off linetype / $rr co oo ex ge ax tip)
  (setq;|a13651|;
	 $rr 0
	 tip (quote INT)
	 oo (if (=  (type on_off) tip) on_off 0)
	 co (if (=  (type coloriz) tip) coloriz 7)
	 ax (if (>  a245 "") (strcase a245 T) "a245errorS")
	 ex (if (tblsearch "LAYER" a245) 1 0)) (if (=  ex 0) (progn  (setq;|a13911|;
	 ge (entmakex (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 ax) (cons 70 oo) (cons 62 co)))) (setq;|a14081|;
	 $rr (if ge 1 RTERROR)))) (if (<  ex 0) (setq;|a14127|;
	 $rr -5003)) 
$rr)

//Out:rr:int=(rterror. internal failed)
// (1.okai layer created)
// (0.okai layer already exist)
// (rtrej. invalid file name)

How to Call ? (dfn_layer_new "namelayer" 10 1 "disabled-NowL:ineType")

[Anonymous]

So Sorry, please find below, and also if we can less Decimal it will be great..

[ВeekeeCZ · Accepted solution]

OK, is this all you need?

[Anonymous]

Thanks very much, I have to make more lisps for each number or can you help me to combine it in one file, because I have in design 2 numbers (9.1 / 6.25 ) and also I need to keep original AREAON lisp, so I need 3 lisps in one lisp,

AREAON9.1 + AREAON6.25+AREAON


Sorry for more inquiry.

[ВeekeeCZ · Accepted solution]

It's not difficult, you have nice examples in the code already.

I made both versions, those with predefined divisor and also one where is a prompt for the user. Explore both and pick the one which suits more your workflow better.

Good luck.

[Anonymous]

It's great, thanks very very much.

[ВeekeeCZ]

@hmsilva  

Thanks! Glad to see you around!

[diagodose2009]

I replace (command "layer" unlock...") with  dfn_layer_slayerxp.

(defun dfn_layer_slayerxp(lname fMatchCase / $rr sym mode eobj tbl gap stc rst)
  (setq;|a22828|;
	 rst (jc_aro10 "C051read" (list  "STR"))
	 $rr stLayerName
	 $rr (if (=  $rr nil) (jc_aro10 "C052getvar" (list  "CLAYER")) $rr)) (jc_aro10 "C053vl_load_com" (list )) (setq;|a22934|;
	 stc (if (=  fMatchCase nil) "on3thaw" (if (/= (type fMatchCase) rst) "on4unlock" (jc_aro10 "C054strcase" (list  fMatchCase T))))
	 eobj nil) (if (and (=  (type $rr) rst) (>  $rr "")) (progn  (setq;|a23076|;
	 eobj (jc_aro10 "C055tblobjname" (list  "layer" $rr))
	 eobj (if tbl (jc_aro10 "C056vlax-ename->vla-object" (list  eobj)) nil)))) (if (and  eobj stc) (progn  (if (jc_aro10 "C057wcmatch" (list  stc "*thaw*")) (jc_aro10 "C058vl-catch-all-error-p" (list  (jc_aro10 "C059vla-put-layeron" (list  eobj vlax_false)))) (if (jc_aro10 "C060wcmatch" (list  stc "*freeze*")) (jc_aro10 "C061vl-catch-all-error-p" (list  (jc_aro10 "C062vla-put-freeze" (list  eobj vlax_true)))))) (if (jc_aro10 "C063wcmatch" (list  stc "*unlock*")) (jc_aro10 "C064vl-catch-all-error-p" (list  (jc_aro10 "C065vla-put-lock" (list  eobj vlax_false)))) (if (jc_aro10 "C066wcmatch" (list  stc "*lock*")) (jc_aro10 "C067vl-catch-all-error-p" (list  (jc_aro10 "C068vla-put-lock" (list  eobj vlax_true)))))) (if (jc_aro10 "C069wcmatch" (list  stc "*noplot*")) (jc_aro10 "C070vl-catch-all-error-p" (list  (jc_aro10 "C071vla-put-plottable" (list  eobj vlax_false)))) (if (jc_aro10 "C072wcmatch" (list  stc "*plot*")) (jc_aro10 "C073vl-catch-all-error-p" (list  (jc_aro10 "C074vla-put-plottable" (list  eobj vlax_true)))))) (if (jc_aro10 "C075wcmatch" (list  stc "*off*")) (jc_aro10 "C076vl-catch-all-error-p" (list  (jc_aro10 "C077vla-put-layeron" (list  eobj vlax_false)))) (if (jc_aro10 "C078wcmatch" (list  stc "*on*")) (jc_aro10 "C079vl-catch-all-error-p" (list  (jc_aro10 "C080vla-put-layeron" (list  eobj vlax_true)))))) (if (jc_aro10 "C081wcmatch" (list  stc "*set*")) (jc_aro10 "C082setvar" (list  "CLAYER" $rr))))) 
$rr)

I replace (command "TEXT") with function (dfn_enamk_textddt "")

Can  you test the getCentroid from LeeMac?

[ВeekeeCZ]

@diagodose2009 

Not really sure if this was intended so just for you to know, your posted code looks like this to me. 

[Anonymous]

Dear mr.beekee 

Thanks a lot for your helping, can you please edit this lisp to working with Hatch same polyline (give me all areas or GPM for all hatches by one select)