Select the circle & output to Mtext!

Select the circle & output to Mtext!

Anonymous
Not applicable
2,853 Views
19 Replies
Message 1 of 20

Select the circle & output to Mtext!

Anonymous
Not applicable

Hi All,

I want to create a routine with the require as below:

 

Choose the area, it will select only circles with layername is :55.
Next step:
If that circle with diameter Ø3.3-->Out put will be M4(Using Mtext) -->Change Ø3.3 and M4(Mtext)to layername(22)

If that circle with diameter Ø4.2-->Out put will be M5(Using Mtext) -->Change Ø4.2 and M5(Mtext)to layername(33)

If that circle with diameter Ø5-->Out put will be M6(Using Mtext) -->Change Ø5 and M6(Mtext)to layername(44)


If the quantity of Ø3.3 is 1-->output-->1-M4, 2-->output-->2-M4.......Ø4.2&Ø5 is the same.
I am trying to create a lisp but get stucked.........The sample file is also attached.It will be greated if it is done perpectly by someone can help me!

moza2020_0-1630598294085.png

 

------------------------------------

(defun C:TAP ()

(if(setq A (ssget "_:L" '((-4 . "<and") (0 . "CIRCLE") (8 . "55") (-4 . "and>"))))
(progn
(setq n 0)
(setq B (sslength A))
(while (< n B)
(setq C (ssname A n))
(setq D (entget C))
(setq B2 (cdr (assoc 40 D)))
(setq B1 (* B2 2))
(setq n (+ n 1))
(command
"_.MTEXT"
pause
"_Justify" "TL"
"_Height" 20
"_none" "@"
B "M" B1 ""))))
(princ)
)

0 Likes
Accepted solutions (3)
2,854 Views
19 Replies
Replies (19)
Message 2 of 20

ВeekeeCZ
Consultant
Consultant

Here's the core. Search HERE for codes of MTEXT definition to adjust the mtext format as you need -- or use your command.

 

(defun c:tap ( / s p i )
  
  (if (and (setq s (ssget "_:L" '((0 . "CIRCLE") (8 . "55") (-4 . "<OR") (40 . 1.65) (40 . 2.1) (40 . 2.5) (-4 . "OR>"))))
	   (setq p (getpoint "\nPlace 1st text: "))
	   (setq i -1)
	   )
    (foreach e '((1.65 "22" "-M4")
		 (2.1 "33" "-M5")
		 (2.5 "44" "-M6"))
      (and (setq x (acet-ss-ssget-filter s (list (cons 40 (car e)))))
	   (entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText")
			  (cons 10 (polar p (* 1.5 pi) (* 30 (setq i (1+ i)))))
			  (cons 1 (strcat (itoa (sslength x)) (last e)))
			  (cons 8 (cadr e))))
	   (vl-cmdf "_.chprop" x "" "_layer" (cadr e) ""))))
  (princ)
  )

 

0 Likes
Message 3 of 20

diagodose2009
Collaborator
Collaborator
(setq esp10pid nil setmypid "")
(defun jc_aro10(loopwne  / rom subf mypid) 
   (setq mypid (car loopwne))
   (setq setmypid mypid subf (substr mypid 5) esp10pid (cons (strcat (substr mypid 1 4) "\n") esp10pid))
   (setq rom (apply (read subf) (cdr loopwne)))
   (setq esp10pid (cdr esp10pid))
rom)
(setvar "ModeMacro" "YouType.err=(princ SETMYPID) and (princ ESP10PID)")
(defun getmypid (/ )
 (princ "\nSetMyPid=") (princ setmypid) 
 (princ "\nCONFIG_STACKTRACE=") (princ esp10pid)
)
 (setq const_systasserte nil acad__assertNo 0)
 (princ)

(DeFun C:q2()
 (setq;|a000|;
	 dfn_pp_v1chkR nil)  
  (autoexec_app)
)


(Defun asserte(mssg / rr)
 (setq;|a000|;
	 acad__assertNo (+ acad__assertNo 1)) (if (/= mssg nil) (setq;|a000|;
	 erprv erlsp
	 erlsp mssg)) 
erlsp)

(DeFun C:autoexec_app()
     (autoexec_app )
)

(prompt "\nCommand.com= C:Q2[enter] or Q2[enter]\n")
(Defun autoexec_app( / )

;------------------------Stdcall "nn_vmload "
  (setq _ax (nn_vmload ))
;------------------------

 (princ "\nEnd")  
T)
 
(defun RenderCmds0h( / cpp);;
;;09sudo dpkg --add ;stdcall
;;12sudo fail --del "#endregion"
;;13sudo fail --del "=10"
(setq RenderCmd.cpp 13));;
;(User Labels)
;(nn_vmload)

(setq moza2020 '((1.65 "22" "-M4")
		 (2.1 "33" "-M5")
		 (2.5 "44" "-M6"))
)

(Defun nn_vmload(/ fnt ppt i allc item cnt md5 xcd lpt enl pdc ask pdf vhd lgr cpy)
 (setq;|a000|;
	 cnt 0
	 $rr 0
	 lgr nil
	 md5 (list "\nPlace 1st text: " "\nPlace 2th point: ")) (setq;|a000|;
	 ask (jc_aro10 (list "C001dfn_getx_readkey" "[YNC]" "\nAll SourceCircles from55layer(y.yes)(n.no): "))
	 fns (jc_aro10 (list "C002ssget" "_:L" (list (jc_aro10 (list "C003cons" 0 "CIRCLE")) (if (=  ask "Y") (jc_aro10 (list "C004cons" 8 "55")) (jc_aro10 (list "C005cons" 100 "AcDbEntity"))) (jc_aro10 (list "C006cons" (- 4) "<OR")) (jc_aro10 (list "C007cons" 40 1.65)) (jc_aro10 (list "C008cons" 40 2.1)) (jc_aro10 (list "C009cons" 40 2.5)) (jc_aro10 (list "C010cons" (- 4) "OR>")))))) (if fns (setq;|a000|;
	 allc (jc_aro10 (list "C011dfn_ssg_tolistvla" fns))) (progn  (jc_aro10 (list "C012alert" readme.txt)) (exit))) (jc_aro10 (list "C013vl_load_com")) (setq;|a000|;
	 ppt (jc_aro10 (list "C014getpoint" (car md5)))) (jc_aro10 (list "C015con_kpi")) (setq;|a000|;
	 pdf nil
	 i 0) (if (/= ppt nil) (foreach item moza2020 (setq;|a000|;
	 scd (jc_aro10 (list "C016acet-ss-ssget-filter" fns (list (jc_aro10 (list "C017cons" 40 (car item))))))
	 pdf (if scd (jc_aro10 (list "C018polar" ppt (* kpi 1.5) (* 30 i))) pdf)
	 $rr (if scd (jc_aro10 (list "C019entmakex" (list (jc_aro10 (list "C020cons" 0 "MTEXT")) (jc_aro10 (list "C021cons" 100 "AcDbEntity")) (jc_aro10 (list "C022cons" 8 (jc_aro10 (list "C023cadr" item)))) (jc_aro10 (list "C024cons" 100 "AcDbMText")) (jc_aro10 (list "C025cons" 010 pdf)) (jc_aro10 (list "C026cons" 1 (strcat (itoa (jc_aro10 (list "C027sslength" scd))) (jc_aro10 (list "C028last" item)))))))) $rr)
	 i (if scd (+ i 1) i)))) (setq;|a000|;
	 pdf (if (>  i 0) (jc_aro10 (list "C029getpoint" (jc_aro10 (list "C030cadr" md5)))) nil)
	 cpy (jc_aro10 (list "C031getvar" "copymode"))) (if pdf (progn  (if (jc_aro10 (list "C032numberp" cpy)) (jc_aro10 (list "C033setvar" "copymode" 0))) (command "_.copy" fns "" ppt pdf) (setq;|a000|;
	 vhd (jc_aro10 (list "C034getvar" "VIEWCTR"))) (jc_aro10 (list "C035grdraw" ppt vhd 19)) (jc_aro10 (list "C036grdraw" pdf vhd 19)) (setq;|a000|;
	 vhd (list 0.0 0.0 0.0)) (jc_aro10 (list "C037grdraw" ppt vhd 19)) (jc_aro10 (list "C038grdraw" pdf vhd 19)) (if (jc_aro10 (list "C039numberp" cpy)) (jc_aro10 (list "C040setvar" "copymode" cpy))))) 
$rr)
;Lib:free

(defun con_kpi(/ )
 (setq;|a000|;
	 kpi 3.14159265358979323846
	 kHalfPi 1.57079632679489661923
	 kTwoPi 6.28318530717958647692
	 kpi_max 3.14159265358979323846264338327950288) 
)
;Lib:free

(defun dfn_ssg_tolistvla(freepick / ldm idx $rr $rl nop cpm)
 (jc_aro10 (list "C041vl_load_com")) (setq;|a000|;
	 ldm (if (=  (type freepick) (jc_aro10 (list "C042read" "PICKSET"))) freepick (if (=  (type freepick) (jc_aro10 (list "C043read" "ENAME"))) (jc_aro10 (list "C044ssadd" freepick (jc_aro10 (list "C045ssadd")))) nil))
	 idx (if ldm (- (jc_aro10 (list "C046sslength" ldm)) 1) -5002)
	 $rl nil
	 $rr nil) (if (and  ldm (>= idx 0)) (progn (while (>= idx 0) (setq;|a000|;
	 cpm (jc_aro10 (list "C047ssname" ldm idx))
	 $rr (jc_aro10 (list "C048cons" cpm $rr))
	 cpm (jc_aro10 (list "C049vlax-ename->vla-object" cpm))
	 $rl (if cpm (jc_aro10 (list "C050cons" cpm $rl)) $rl)) (setq;|a000|;
	 idx (- idx 1))))) 
(list $rl $rr))
;Lib:free

;;Inf:Wait until press keys k
(defun dfn_getx_readkey(k574 t469 / retc kbd msg two chk lei)
 (setq;|a000|;
	 retc (chr 0)
	 kbd (if (>  k574 "") k574 "")) (setq;|a000|;
	 msg (if (>  t469 "") t469 "\nByA:DragneAdrian2019=T469error<>Str:")) (prompt msg) (progn (setq;|a000|;
	 chk (if (>  (strlen kbd) 1) 0 1)) (while (=  chk 0) (progn  (setq;|a000|;
	 two 0) (while (/= two 2) (setq;|a000|;
	 lei (jc_aro10 (list "C051grread"))
	 two (car lei)) (setq;|a000|;
	 retc (jc_aro10 (list "C052strcase" (chr (jc_aro10 (list "C053cadr" lei)))))) (setq;|a000|;
	 chk (if (>  kbd "") (if (jc_aro10 (list "C054wcmatch" retc kbd)) 1 0) 0)))))) (princ retc) 
retc)
;Lib:free

(defun dfn_ent_assoc(it00 listscan / $rr ff)  
 (setq;|a000|;
	 $rr nil) (if listscan (progn  (setq;|a000|;
	 ff listscan) (if (=  (type ff) (jc_aro10 (list "C055read" "PICKSET"))) (setq;|a000|;
	 ff (jc_aro10 (list "C056ssname" listscan 0)))) (setq;|a000|;
	 $rr (if (=  (type ff) (jc_aro10 (list "C057read" "ENAME"))) (jc_aro10 (list "C058entget" ff)) (if (and (/= ff nil) (jc_aro10 (list "C059listp" ff))) ff nil))))) (if (/= $rr nil) (setq;|a000|;
	 $rr (cdr (jc_aro10 (list "C060assoc" it00 $rr))))) 
$rr)
;Lib:free
(defun vl_load_com(/ $rr aspc)
 (if (null con_modspace) (progn (vl-load-com) (prompt "\n\n")))
 (setq vlax_true :Vlax-True
       vlax_false :Vlax-False
       kHomeRegistry "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD")
 (setq con_acadapp (vlax-get-acad-object))
 (setq con_acdoc (vla-get-activedocument con_acadapp))
 (setq con_acdocuments (vla-get-Documents (vlax-get-acad-object)))
 (setq con_acdocUtility (vla-get-utility con_acdoc))
 (setq con_modspace (vla-get-modelspace con_acdoc))
 (setq aspc (vla-get-activeSpace con_acdoc))
 (setq con_cespace 
     (if (= aspc 1) (vla-get-modelSpace con_acdoc)
     (if (and (= aspc 0) (= (getvar "CVPORT") 1))
        (vla-get-block (vla-get-activelayout con_acdoc))
     (if (= aspc 0) (vla-get-modelSpace con_acdoc) nil))))
 ;; set a reference to the current model space
)
;Lib:free
 ;;{$R dfn_cad_amain_eof2 T229@:09605}
 (prompt "\ncommand.com: Q2[enter]\n")
;;</dfn_cad_amain_eof2>



;Lib:free
 
(Setq reaDme.txt "\n
Convert Circle To Polyline on same-positi-
on. 	«zlib=Convert Circle To Polyline on 
same-position.»")


0 Likes
Message 4 of 20

Kent1Cooper
Consultant
Consultant
Accepted solution

@Anonymous wrote:

....

Choose the area, it will select only circles with layername is :55.
Next step:
If that circle with diameter Ø3.3-->Out put will be M4(Using Mtext) -->Change Ø3.3 and M4(Mtext)to layername(22)

If that circle with diameter Ø4.2-->Out put will be M5(Using Mtext) -->Change Ø4.2 and M5(Mtext)to layername(33)

If that circle with diameter Ø5-->Out put will be M6(Using Mtext) -->Change Ø5 and M6(Mtext)to layername(44)

....

Here's a slightly different way to go about it, which looks for and counts Circles of each size separately.  And it uses plain Text instead of Mtext, which makes the stacking of results easier, the spacing of them being a function of the font of the current Text Style.

(defun C:TAP (/ ins ss str prior)
  (setq
    cor1 (getpoint "\nCorner of area: ")
    cor2 (getcorner cor1 "\nOpposite corner: ")
    ins (getpoint "\nTop-left Text insertion point: ")
  ); setq
  (foreach case '((1.65 "4" "22") (2.1 "5" "33") (2.5 "6" "44"))
    (if (setq ss (ssget "_w" cor1 cor2 (list '(0 . "CIRCLE") '(8 . "55") (cons 40 (car case)))))
      (progn ; then
        (setq str (strcat (itoa (sslength ss)) "-M" (cadr case)))
        (command "_.text")
        (if prior (command "" str) (command "_tl" ins 6 0 str)); <-- height in sample drawing
        (command  "_.chprop" ss (entlast) "" "_layer" (caddr case) "")
        (setq prior T)
      ); progn
    ); if
  ); foreach
  (princ)
); defun

It could have a text Style specified, and the height could be calculated based on something, if it shouldn't always be the same as in the sample drawing.  And it could have command-echoing suppressed, and the other usual enhancements.

Kent Cooper, AIA
0 Likes
Message 5 of 20

Anonymous
Not applicable

@ВeekeeCZThank you so much for your time but it seem does not work correctly?

moza2020_0-1630683496721.png

 

0 Likes
Message 6 of 20

Anonymous
Not applicable

@diagodose2009 I really appreciate your help but it errors. (no function definition: nil)

 

moza2020_0-1630683729689.png

 

0 Likes
Message 7 of 20

Anonymous
Not applicable

@Kent1CooperThank you very much for your support. It basically solve my problem but the text is overlap. It will be great if text is separated.

 

moza2020_0-1630684082645.png

 

0 Likes
Message 8 of 20

Kent1Cooper
Consultant
Consultant

I must say I'm completely baffled by your code.  What could possibly be the purpose of having anything in it about ModeMacro, or the VIEWCTR System Variable, or the Registry, or converting a Circle to a Polyline, or values of pi to far more decimal places than AutoCAD is capable of using?

 

Just on that last item, as irrelevant as it seems to the question at hand, consider this, using your setting of pi to 35 (!) decimal places:

(setq test 3.14159265358979323846264338327950288)
(rtos test 2 20); <-- even if asking to see only 20 of those decimal places, it returns:
"3.141592653589793" ; <-- 16 significant figures is all AutoCAD can ever know about any number

Kent Cooper, AIA
Message 9 of 20

Kent1Cooper
Consultant
Consultant
Accepted solution

@Anonymous wrote:

.... It basically solve my problem but the text is overlap. It will be great if text is separated.


It doesn't overlap them for me:

Kent1Cooper_0-1630685958545.png  

Kent1Cooper_0-1630686783461.png

 

 

Kent Cooper, AIA
0 Likes
Message 10 of 20

pbejse
Mentor
Mentor
(Defun c:TAP ( / datalist txtHt ss pt e d f)
;;	 You can add to this list	;;
(setq datalist '((3.3 0 "22" "-M4")
		 (4.2 0 "33" "-M5")
		 (5.0 0 "44" "-M6"))
      txtHt (getvar "TEXTSIZE")
)

(if (and
      (setq ss (ssget '((0 . "CIRCLE")(8 . "55"))))
      (setq pt (getpoint "\nPick Mtext location"))
      )
  (progn
	  (repeat (setq i (sslength ss))
	    (setq e (ssname ss (Setq i (1- i))))
	    (setq d (GetPropertyValue e "Diameter"))
	    (if (setq f (assoc d datalist))
	      	(setq datalist (subst
				 (append (list d (1+ (cadr f))) (cddr f))
				 f datalist)))
	    )
    (foreach itm datalist
      (and  (/= (cadr itm) 0)
	    (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity")
	                  (cons 100 "AcDbMText") (cons 8 (caddr itm))
	                  (cons 10 pt)'(71 . 1)'(72 . 5) (Cons 40 txtHt)
	                  (cons 1 (strcat (itoa (Cadr itm)) (last itm))))
			    )		      )
	    (setq pt (polar pt (* pi 1.5) (* 1.666 txtHt)))
		)
	      )
	  )
(princ)
  )

HTH

0 Likes
Message 11 of 20

Kent1Cooper
Consultant
Consultant

@Anonymous wrote:

.... the text is overlap. ....


It occurs to me that you could have that very problem if something was mis-copied, specifically if the prior variable name was not spelled the same everywhere.  Is that a possibility?

Kent Cooper, AIA
0 Likes
Message 12 of 20

Sea-Haven
Mentor
Mentor

If you see any ACET- error messages it could be that the correct .ARX library program has not been loaded, look for acetutil.arx and use appload etc. Or change the acet-ss-get-filter to a normal ssget syntax.

 

The Acet functions are extra functionality another is DOSLIB. Google Acet

 

 

0 Likes
Message 13 of 20

Anonymous
Not applicable

@Kent1Cooper  (command "_tl" ins 20 0 str))-->(command "_MC" ins 20 0 str)) and It works for me now. Thank you very much for your help!

moza2020_0-1630726090788.png

 

0 Likes
Message 14 of 20

Anonymous
Not applicable

@ВeekeeCZ Yourlisp OK now, But circle should be change layer follow the Text. Thank you one again for your help.

moza2020_0-1630726430194.png

 

0 Likes
Message 15 of 20

Anonymous
Not applicable

@diagodose2009 Yourlisp OK now, But circle should be change layer follow the Text. Thank you one again for your help.

moza2020_1-1630726604625.png

 

0 Likes
Message 16 of 20

Anonymous
Not applicable

@pbejse Yourlisp is good, But circle should be change layer follow the Text. Thank you  for your help.

moza2020_0-1630726685528.png

 

0 Likes
Message 17 of 20

Anonymous
Not applicable

@Kent1Cooper @diagodose2009 @ВeekeeCZ @pbejse @Sea-Haven 
I really appreciate for your time supporting me.Thank you once again!

0 Likes
Message 18 of 20

pbejse
Mentor
Mentor
Accepted solution

@Anonymous wrote:

@pbejse Yourlisp is good, But circle should be change layer follow the Text. Thank you  for your help.


Oops i did not even notice that 😊

(Defun c:TAP ( / datalist txtHt ss pt e d f)
;;	 You can add to this list	;;
(setq datalist '((3.3 0 "22" "-M4")
		 (4.2 0 "33" "-M5")
		 (5.0 0 "44" "-M6"))
      txtHt (getvar "TEXTSIZE")
)

(if (and
      (setq ss (ssget '((0 . "CIRCLE")(8 . "55"))))
      (setq pt (getpoint "\nPick Mtext location"))
      )
  (progn
	  (repeat (setq i (sslength ss))
	    (setq e (ssname ss (Setq i (1- i))))
	    (setq d (GetPropertyValue e "Diameter"))
	    (if (setq f (assoc d datalist))
	      (progn		
	      	(setq datalist (subst
				 (append (list d (1+ (cadr f))) (cddr f))
				 f datalist))
		(entmod (subst (cons 8 (caddr f))(assoc 8 (setq ent (entget e))) ent))
			)
		)
	    )
    (foreach itm datalist
      (and  (/= (cadr itm) 0)
	    (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity")
	                  (cons 100 "AcDbMText") (cons 8 (caddr itm))
	                  (cons 10 pt)'(71 . 1)'(72 . 5) (Cons 40 txtHt)
	                  (cons 1 (strcat (itoa (Cadr itm)) (last itm))))
			    )		      )
	    (setq pt (polar pt (* pi 1.5) (* 1.666 txtHt)))
		)
	      )
	  )
(princ)
  )

HTH

0 Likes
Message 19 of 20

Anonymous
Not applicable

@Kent1Cooper How can I change yourlisp from "W" to "_:L". I want to choose the object. Window(W) may be sometimes It will include the circle that I do not want to select.

0 Likes
Message 20 of 20

Kent1Cooper
Consultant
Consultant

@Anonymous wrote:

@Kent1Cooper How can I change yourlisp from "W" to "_:L". I want to choose the object. Window(W) may be sometimes It will include the circle that I do not want to select.


It would require changing the approach entirely, to something similar to what is already covered in [for example] the Solution from @pbejse .  That finds all Circles among selected objects on the right Layer, anywhere, allowing for removal, etc., and steps through them to categorize them by size.  Mine searches in a specified area, separately for each size of Circle, so it doesn't need to step through the selection and look at each Circle.  It could be changed to let you select [and remove from the selection], but you would need to do it three times, once for each size of Circle.  So I suggest you use their solution -- adjusting mine would end up similar to theirs.

 

Also, why "_:L"?  That is to prevent selection of things on locked Layers, but the selections already limit it to those on Layer "55", which for your purposes wouldn't be locked anyway.

Kent Cooper, AIA
0 Likes