Silvercloak Posted August 7, 2019 Posted August 7, 2019 I'm trying to write a simple code for our suveyors to put area text into their linework. Long story short, they want the text to be annotative and an oblique angel of 75 degrees. My skills are fairly rudimentary at best. I figure I'll post here and if anyone cares to tweak this; great. If not, my guy will just have to live with fixing the text after he's placed it. (defun artos (x / u i) ; Area Real To String - metric ;hanhphuc (eval (cons 'strcat (reverse (list (setq x (float x) u (if (< (setq i (/ (abs x) 1e+4)) 0.1) " m%%253" " ha" ) ) (cons 'rtos (if (= u " ha") (list (/ x 1e+4) 2 1) (list x 2 1) ) ) ) ) ) ) ) (defun c:a (/ en p) ; localized variables (while ; loop if entity is selected (and (setq en (car (entsel "\nPick area entity.. "))) ; select 2D entity (vlax-property-available-p (vlax-ename->vla-object en) 'area) ; check whether has 'area' property (setq p (getpoint "\nSpecify text placement point.. ")) ; locate text insertion point (entmakex (list '(0 . "TEXT") '(8 . "leg-area") ; to avoid command call (cons 1 (artos (vlax-curve-getarea en))) ; convert area value to string using sub function (cons 7 "L80") (cons 10 (trans p 1 0)) ; text insertion point ;(cons 50 (* pi 0.5)) ; angle 90d (cons 40 (getvar 'textsize)) ; text height, command: textsize ) ) ) ) (princ) ) Silvercloak Quote
Lee Mac Posted August 7, 2019 Posted August 7, 2019 (edited) I don't have much experience working with Annotative objects, but the following should perform as required: (defun c:a ( / ang cmd ent hgt ins obj obl ocs sty txt ) (setq sty (if (tblsearch "style" "L80") "L80" (getvar 'textstyle)) hgt (getvar 'textsize) obl (* pi (/ 75.0 180.0)) ocs (trans '(0 0 1) 1 0 t) ang (angle '(0 0) (trans (getvar 'ucsxdir) 0 ocs t)) ) (while (progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect an object with area: "))) (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again.") ) ( (null ent) nil) ( (not (vlax-property-available-p (setq obj (vlax-ename->vla-object ent)) 'area)) (princ "\nThe selected object has no area property.") ) ( (setq ins (getpoint "\nSpecify text insertion point: ")) (setq txt (entmakex (list '(000 . "TEXT") '(008 . "leg-area") (cons 007 sty) (cons 040 hgt) (cons 001 (artos (vla-get-area obj))) (cons 050 ang) (cons 051 obl) (cons 010 (trans ins 1 ocs)) (cons 210 ocs) ) ) ) (setq cmd (getvar 'cmdecho)) (setvar 'cmdecho 0) (vl-cmdf "_.chprop" txt "" "_A" "_Y" "") (setvar 'cmdecho cmd) ) ) ) ) (princ) ) (defun artos ( a ) (if (< a 1000) (strcat (rtos a 2 1) " m%%253") (strcat (rtos (* a 1e-4) 2 1) " ha") ) ) (vl-load-com) (princ) Edited August 7, 2019 by Lee Mac 1 Quote
Silvercloak Posted August 7, 2019 Author Posted August 7, 2019 That almost works perfectly. For some reason the oblique angle comes in at 15 degrees though. Not sure why. Quote
Lee Mac Posted August 7, 2019 Posted August 7, 2019 (edited) 21 minutes ago, Silvercloak said: That almost works perfectly. For some reason the oblique angle comes in at 15 degrees though. Not sure why. I'm guessing your ANGBASE is non-zero - change: obl (* pi (/ 75.0 180.0)) To: obl (* pi (/ 15.0 180.0)) Edited August 7, 2019 by Lee Mac 1 Quote
Silvercloak Posted August 7, 2019 Author Posted August 7, 2019 Perfect. Thanks for your time Lee! Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.