Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 02/10/2025 in Posts

  1. (command "text" "_c" (list (+ (atof ptx) (/ (atof httt) 2.0)) (- (cadr v) 8.40)) httt "0" xstr) (command "text" "_c" (list (+ (atof ptx) (/ (atof httt) 2.0)) (- (cadr v) 6.00)) httt "0" ystr) I wasn't sure if I had to use ptx or pty in second command line so I changed it to pty but probably it so be twice ptx?
    1 point
  2. not sure if this helps let alone work because I have nothing to test (and 3D / trans is not my thing) but maybe it at least can inspire you. It could also be a case of just a few typo's : ;;; right coordinates (string) , wrong position (defun write-vertices (newvlist mode / xstr ystr zstr str transformed_pt) (setvar 'osmode 0) (setq httt (if mode "0.35" "1.75")) (command "_layer" "_m" "GROUND2 TEXT" "_c" "7" "" "" "style" "PMSF-TEXT 2" "Arial" "" "" "" "" "") (foreach item newvlist ; Transforms the point to the new UCS (setq transformed_pt (trans item 0 1) ;;; Correct x coordinate xstr (rtos (- (car transformed_pt) (car v)) 2 2) ;;; Correct y coordinate and add Ycoord ystr (rtos (+ (- (cadr transformed_pt) (cadr v)) Ycoord) 2 2) zstr (rtos (nth 2 transformed_pt) 2 2) ;;; when / where is str used? str (strcat xstr (spaces xstr) ystr (spaces ystr) zstr) ) (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (- (cadr v) 8.40)) httt "0" xstr) (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (- (cadr v) 6.00)) httt "0" ystr) ) ) ;;; But now put the coordinates inwrong possiton ;;; The previous code put the text in correct possition but have wrong coordinates ;;; wrong coordinates (string) , right position (points) (defun write-vertices (newvlist mode / xstr ystr zstr str) (setvar 'osmode 0) (command "_layer" "_m" "GROUND2 TEXT" "_c" "7" "" "") (setq httt (if mode "0.35" "1.75")) (foreach item newvlist (setq xstr (rtos (nth 0 item) 2 2) ystr (rtos (nth 1 item) 2 2) zstr (rtos (nth 2 item) 2 2) ;;; is str the combined string for x / y and if so where is it useds? str (strcat xstr (spaces xstr) ystr (spaces ystr) zstr) ) (command "style" "PMSF-TEXT 2" "Arial" "" "" "" "" "") (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (- (cadr v) 8.40)) httt "0" xstr) ;;; its says atof xstr but maybe ystr? ................................................. str? (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (- (cadr v) 6.00)) httt "0" ystr) ) ) ;;; best of both worlds : use points from 2nd posted routine and strings from 1st (defun write-vertices (newvlist mode / ptx pty ptz xstr ystr zstr str) (setvar 'osmode 0) (setq httt (if mode "0.35" "1.75")) (command "_layer" "_m" "GROUND2 TEXT" "_c" "7" "" "" "style" "PMSF-TEXT 2" "Arial" "" "" "" "" "") (foreach item newvlist ;;; right strings (setq transformed_pt (trans item 0 1) ; Transforms the point to the new UCS xstr (rtos (- (car transformed_pt) (car v)) 2 2) ; Correct x coordinate ystr (rtos (+ (- (cadr transformed_pt) (cadr v)) Ycoord) 2 2) ; Correct y coordinate and add Ycoord zstr (rtos (nth 2 transformed_pt) 2 2) str (strcat xstr (spaces xstr) ystr (spaces ystr) zstr)) ;;; right coordinates (used other variable names to keep'm apart (setq ptx (rtos (nth 0 item) 2 2) pty (rtos (nth 1 item) 2 2) ptz (rtos (nth 2 item) 2 2) str (strcat xstr (spaces xstr) ystr (spaces ystr) zstr)) (command "text" "_c" (list (+ (atof ptx) (/ (atof httt) 2.0)) (- (cadr v) 8.40)) httt "0" xstr) (command "text" "_c" (list (+ (atof pty) (/ (atof httt) 2.0)) (- (cadr v) 6.00)) httt "0" ystr) ) )
    1 point
  3. Changing the text's basepoint to middle center is definitely the way to go, because if there's ever a change needed in the text, it will stay centered to the circle. It's also the easiest to code from this way. However, if circumstances do not allow you to change the base point of the text, then it's not like it still can't be done: Use the textbox function to determine the boundary points of the text. Include the text style and height so the calculations are correct. (unless vla-GetBoundingBox alone can calculate the bounding of MTEXT without taking into consideration the mtext width). Use the midpoint of the coordinates returned to place it in the center of the circle. It involves a bit of calculation, so I'll leave it to the other programmers to write it up.
    1 point
  4. This first one will justify Middle Centre where the calling function sends 'mc' for justification. One to keep handy and you can expand this to include other justifications such as Top, Middle Left, Bottom Right as more examples. (defun c:jumc() (jut "mc") ) (defun jut (just / var ent) ;;https://www.cadtutor.net/forum/topic/35569-text-justification-lisp/ (princ (strcat "\nSelect Text")) (if (setq ss (ssget "_:L" '((0 . "ATTDEF,MTEXT,TEXT")))) (command "_.justifytext" ss "" just) ) (princ) ) Lees code above is quite simple and you should be able to put this in there to justify centre the text. Do the justification before moving.
    1 point
  5. nada testing... (defun c:foo ( / *error* ord fn del des ent idx lst obj out sel ) (defun *error* (msg) (if (= 'file (type des)) (close des)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))(princ (strcat "\nError: " msg)))(princ)) (setq ord '("DIAT" "KM" "EO" "EE") del ",") (setq fn (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)))) (cond ((not (setq out (getfiled "Choose where to save the file" fn "txt" 1))) (princ "\nNo file path provided.")) ((not (setq sel (ssget '((0 . "INSERT") (66 . 1))))) (princ "\nNo blocks with attributes were found")) ((not (setq des (open out "w"))) (princ (strcat "\nUnable to open file: \"" out "\" for writing."))) (t (repeat (setq idx (sslength sel)) (setq ent (ssname sel (setq idx (1- idx))) obj (vlax-ename->vla-object ent)) (setq lst (mapcar '(lambda (x) (cons (strcase (vla-get-tagstring x)) (vla-get-textstring x))) (vlax-invoke obj 'getattributes) ) ) ) (setq lst (vl-remove 'nil (mapcar '(lambda (x) (cdr (assoc x lst))) ord))) ;;; (setq lst '(("k1" "135.25" "4.25" "2.54") ("y2" "0.00" "1.05" "2.00") ("s2" "20.00" "1.25" "2.35"))) (setq lst (vl-sort lst (function (lambda (a b) (< (atof (cadr a)) (atof (cadr b))))))) ;;; (("y2" "0.00" "1.05" "2.00") ("s2" "20.00" "1.25" "2.35") ("k1" "135.25" "4.25" "2.54")) (if (not (vl-consp lst)) (princ "\nNo items to write") (foreach item lst (write-line (LM:lst->str item del) des)) ) ) ) (if (= 'file (type des)) (close des))(gc) (princ) )
    1 point
  6. Okay, the answer is "Yes, at least one of us here knows how to un-protect this lisp file." But I'm in no hurry to do it for you. The author of this file protected it for a reason, and if you were the author, you have the source code somewhere backed up.
    1 point
  7. Why does the LISP have to be recursive? Give this a try: ;; Text 2 Point - Lee Mac 2012 ;; Prompts for a selection of Text and Point entities and moves ;; each Text entity to the nearest (2D distance) Point entity in the set. ;; ;; Retains existing Text elevation. (defun c:txt2pt ( / _textinsertion di1 di2 dxf ent inc ins lst mpt pnt sel txt ) (defun _textinsertion ( elist ) (if (and (zerop (cdr (assoc 72 elist))) (zerop (cdr (assoc 73 elist))) ) (cdr (assoc 10 elist)) (cdr (assoc 11 elist)) ) ) (if (setq sel (ssget "_:L" '((0 . "POINT,TEXT")))) (progn (repeat (setq inc (sslength sel)) (setq ent (entget (ssname sel (setq inc (1- inc))))) (if (eq "POINT" (cdr (assoc 0 ent))) (setq lst (cons (cdr (assoc 10 ent)) lst)) (setq txt (cons (cons (_textinsertion ent) ent) txt)) ) ) (foreach ent txt (setq ins (list (caar ent) (cadar ent))) (if (setq pnt (vl-some '(lambda ( pnt ) (equal ins (list (car pnt) (cadr pnt)) 1e-8)) lst)) (setq lst (vl-remove pnt lst)) (progn (setq di1 (distance ins (list (caar lst) (cadar lst))) mpt (car lst) ) (foreach pnt (cdr lst) (if (< (setq di2 (distance ins (list (car pnt) (cadr pnt)))) di1) (setq di1 di2 mpt pnt ) ) ) (setq pnt (list (car mpt) (cadr mpt) (caddar ent)) dxf (cdr ent) dxf (subst (cons 10 pnt) (assoc 10 dxf) dxf) dxf (subst (cons 11 pnt) (assoc 11 dxf) dxf) ) (entmod dxf) (setq lst (vl-remove mpt lst)) ) ) ) ) ) (princ) ) (vl-load-com) (princ) It will prompt for a selection of Text and Point entities and move each Text entity to the nearest Point entity (nearest by 2D distance), unless a Point is already found with equal X/Y coords as the Text entity. The program will retain the existing elevation of the Text entity. Example: It's probably not the most efficient routine, but I don't have time study a better algorithm.
    1 point
  8. I temporarily change the base point to middle centre, then align the text and then reset to as it was - I think the code is a bit long winded but it works
    0 points
×
×
  • Create New...