Lisp modification

Lisp modification

Anonymous
Not applicable
1,100 Views
9 Replies
Message 1 of 10

Lisp modification

Anonymous
Not applicable

Can someone help please with moving text to a new line:

my text in one line now like this: 

Approx. Glass Weight 200kg @ 6.0m2

I need it in two lines like this: 

Approx. Glass Weight

  200kg @ 6.0m2.

 

lisp code:

(defun c:GL ( / fae thk wgt frarr fwgt fwgtm far farsf fip )
(prompt "\nChoose Polyline or Hatch for area and weight calculation: ")
(setq fae (car (entsel)))
(Command "area" "e" fae)
(setq thk (getreal "\Thickness of Glass? in mm: "))
(setq wgt (* thk 2500))
(setq frarr (/ (getvar "area") 1000000))
(setq fwgt (* frarr wgt))
(setq fwgtm (/ fwgt 1000))
(setq far (rtos fwgtm 2 0))
(setq farsf (strcat "Approx. Glass Weight "far" kg @ "(rtos frarr 2 1)"m2."))
(setq fip (getpoint "\nChoose Text Insert Point:"))
(Command "text" "s" "IQ Text 2" "j" "MC" fip "00" farsf)
(princ)
)

0 Likes
Accepted solutions (1)
1,101 Views
9 Replies
Replies (9)
Message 2 of 10

dlanorh
Advisor
Advisor
You cannot have multi line "TEXT" this would need to be "MTEXT". Is there any reason eg (AutoCAD on a MAC) why you cannot run visual lisp (activex) functions? If there isn't this would be a simple modification.

I am not one of the robots you're looking for

0 Likes
Message 3 of 10

Anonymous
Not applicable

Apologies, but I'm not very good at the Lisp thing, I've found this one and modify a little to suit my needs.

I'm using windows (AUtocad 2021) so I believe I can run visual lisp (activex) functions.

Would be very helpful If you can help me with the modification. thank you.   

0 Likes
Message 4 of 10

Kent1Cooper
Consultant
Consultant
Accepted solution

Mtext would be a way to go, but it doesn't need to be Mtext.  Try this modification to make it two lines of Text:

 

....

(setq farsf (strcat far " kg @ " (rtos frarr 2 1) "m2.")); without the constant first line
(setq fip (getpoint "\nChoose Text Insert Point: "))
(Command "text" "s" "IQ Text 2" "j" "MC" fip 0 "Approx. Glass Weight"); the constant

(command "text" "" farsf); the "" proceeds to next line from previous Text, same Style, justification, etc.

....

 

You don't really need the farsf variable for the Text content -- you can just build it inside the Text command:

....

;;; (setq farsf ....); don't bother with this
(setq fip (getpoint "\nChoose Text Insert Point: "))
(Command "text" "s" "IQ Text 2" "j" "MC" fip 0 "Approx. Glass Weight")

(command "text" "" (strcat far " kg @ " (rtos frarr 2 1) "m2."))

....

 

[Another possibility that would simplify the code would be to build a Block  with the "Approx. Glass Weight" first line as an ordinary Text object, and the second line as an Attribute  to which you would assign the second-line content.  Or, the "kg @" and "m2" parts could also be fixed text, and just the number-value text strings assigned to Attributes.]

 

{Those double zeros for the rotation angle weren't doing anything for you....  And that can be just a number -- it doesn't need to be a text string.}

 

Kent Cooper, AIA
0 Likes
Message 5 of 10

dlanorh
Advisor
Advisor

OK. I've modified your lisp to insert MTEXT middle center justification.

 

Try this

 

 

(defun c:GL ( / c_doc c_spc obj a thk wgt frarr fwgt fwgtm far farsf fip w n_obj)

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        obj (vlax-ename->vla-object (car (entsel "\nSelect Polyline or Hatch for area and weight calculation : ")))
  );end_setq
  (cond ( (vlax-property-available-p obj 'area)
          (setq a (vlax-get obj 'area)
                thk (getreal "\Thickness of Glass? in mm: ")
                wgt (* thk 2500)
                frarr (/ a 1000000)
                fwgt (* frarr wgt)
                fwgtm (/ fwgt 1000)
                far (rtos fwgtm 2 0)
                farsf (strcat "Approx. Glass Weight\\P" far " kg @ " (rtos frarr 2 1) "m" (chr 178))
                fip (getpoint "\nSelect Text Insert Point : ")
                w (* (getvar 'textsize) 30)
                n_obj (vlax-invoke c_spc 'addmtext fip w farsf)
          );end_setq
          (mapcar '(lambda (x y) (vlax-put n_obj x y)) (list 'attachmentpoint 'insertionpoint) (list acAttachmentPointMiddleCenter fip))
        )
        (t (alert "Selected Entity has no \"AREA\" property"))
  )
  (princ)
)

 

 

I am not one of the robots you're looking for

0 Likes
Message 6 of 10

ronjonp
Advisor
Advisor

Here's another that allows for multiple selection. It will highlight the entity then you can place the text where you want it.

 

(defun c:gl (/ a p s thk wgt)
  ;; RJP » 2020-08-14
  (if (and (setq s (ssget '((0 . "*POLYLINE,HATCH"))))
	   (setq thk (getreal "\nEnter Thickness of Glass in mm: "))
	   (setq wgt (* thk 2500))
      )
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (redraw e 3)
      (setq a (/ (vlax-curve-getarea e) 1000000))
      (if (setq p (getpoint "\nPick a point to place text: "))
	(entmake (list '(0 . "MTEXT")
		       '(100 . "AcDbEntity")
		       '(67 . 0)
		       ;; Adjust layer here
		       '(8 . "IQ Text 2")
		       '(100 . "AcDbMText")
		       (cons 10 p)
		       ;; Adjust text height here
		       (cons 40 (getvar 'textsize))
		       '(71 . 5)
		       (cons 1
			     (strcat "Approx. Glass Weight\\P"
				     (rtos (/ (* a wgt) 1000) 2 0)
				     "kg @ "
				     (rtos a 2 1)
				     "m2."
			     )
		       )
		       ;; Tries to use the style 'IQ Text 2' else uses current textstyle
		       (cons 7
			     (if (tblobjname "style" "IQ Text 2")
			       "IQ Text 2"
			       (getvar 'textstyle)
			     )
		       )
		       '(11 1. 0. 0.)
		       '(43 . 0.125)
		       '(50 . 0.)
		 )
	)
      )
      (redraw e 4)
    )
  )
  (princ)
)

 

0 Likes
Message 7 of 10

Anonymous
Not applicable

Thanks for the code, but it comes with the error: no function definition: VLAX-CURVE-GETAREA. 

0 Likes
Message 8 of 10

Anonymous
Not applicable

yours comes with the error: no function definition: VLAX-ENAME->VLA-OBJECT

0 Likes
Message 9 of 10

Kent1Cooper
Consultant
Consultant

@Anonymous wrote:

.... error: no function definition: VLAX-CURVE-GETAREA. 


Put this line either at the very top or very bottom of the file, to overcome both of your no-function issues:

(vl-load-com)

Kent Cooper, AIA
Message 10 of 10

ronjonp
Advisor
Advisor

@Anonymous wrote:

Thanks for the code, but it comes with the error: no function definition: VLAX-CURVE-GETAREA. 


As Kent already mentioned add (vl-load-com) to the code and give it a try! It has a bit more error checking than your original. 🍻

0 Likes