Leaderboard

The search pattern \\p must be in capital letter.

Thank you exceed for all your work. TT and UT are both working fine now. I'll check out your latest combined code later (busy with getting some actual work done at the moment). Thanks again.

@valljenYou can use qselect to select only dims and then in the list of properties find 'associative' and choose partial (then change the layer or color in properties until you have fixed each dim makes it easy to go through them all).

You can make defuns for your osnap settings so before dim reset to say end only, type osnap set to what you want and then type osmode can see number to set in defun. (defun C:15 ()(setvar "osmode" 15359)) ; sets all snaps on (defun C:47 ()(setvar "osmode" 47)(setvar "AUNITS" 0)) (defun C:99 ()(setvar "osmode" 99)) (defun C:1 ()(setvar "osmode" 1)) ; end only

If transparency is not the issue, I wanted to share a solution to a similar problem I had when creating PDF files from AutoCAD. If the text in your drawing uses fonts with the extension .shx AutoCAD converts some of the text as PDF comments if you have the variable "pdfshx" set to one. Changing "pdfshx" to zero will not add comments to the final PDF. The PDF file with comments is slow to open, so the problem grows exponentially when adding multiple slow files to an extensive set. Please look at the examples I posted and check the comments for each file with Adobe or Bluebeam. I hope this helps, PDF w PDFSHX set to 0.pdf PDF w PDFSHX set to 1.pdf

All the dims you have highlighted are only partially associated, that is the problem with using dimensions in paper space, you have to be 1000% positive that you are picking a point of geometry and not picking the node point or some other part of one of your other dimensions. Autocad cannot work out what the dims are if you are selecting one end in modelspace and the other end is in paperspasce. It helps a bit to turn of ALL unneccessary osnaps (like node) and then also make sure you are hovering over geometry when dimensioning and not in an area close to the ends of other dims.

Because I didn't edit anything of "LH" in that post, haha I still don't know what LH wants, but looking at additional your code, it seems that you want to make a loft hatch so that not only ucs but also the view is displayed vertically on the screen even when the view is rotated. So I merged your two lisp into one and removed the select part. I hope this helps you. ; command list - 2022.03.21 ; TT - Creates the first text, continues the text on the bottom line. (regardless of UCS) ; UT - Selects text that already exists, and creates text from the bottom line (regardless of UCS) ; LH - "Loft Hatch" is created as MTEXT. (Regardless of the angle of the view) (defun c:TT (/ *error* lll osm edp txt e en2 en3 type1 ) (setvar "cmdecho" 0) (LM:startundo (LM:acdoc)) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (setvar "cmdecho" 1) (princ) ) (graphscr) (setq lll (getvar "clayer")) (setq osm (getvar "osmode")) (command "osnap" "none") (command "layer" "m" "GTEXT" "") (setq edp (getpoint "\n pick point for first text - ")) (setq txt (getstring t "\n input first text value - ")) (command "TEXT" "C" edp "" 0.0 txt) (setq e (entget (entlast))) (setq en2(cdr(assoc -1 e))) (setq en3(entget en2)) (textun) (setvar "osmode" osm) (command "layer" "S" lll "") (setvar "cmdecho" 1) (LM:endundo (LM:acdoc)) (princ) ) (vl-load-com) (defun textun ( / ) (setq txt (getstring t "\n input text - ")) (if (= txt "") (progn (princ "\n end process \n")) (progn (setq textlocation '()) (setq putlocation '()) (setq ss0 (ssadd en2)) (setq lst (LM:textbox en3)) (setq ang (angle (car lst) (last lst))) (setq textsize (cdr (assoc 40 en3))) (setq textlocation (trans (cdr (assoc 10 en3)) 0 1)) (setq ucsang (angle '(0 0) (getvar "ucsxdir"))) (setq ang (- ang ucsang)) (setq putlocation (polar textlocation (+ ang pi) (* textsize 1.5) )) ;(princ "\n ang - ") ;(princ ang) (command "copy" ss0 "" textlocation putlocation) (setq ename2 (entlast)) (setq obj2 (vlax-ename->vla-object ename2)) ;(vla-put-alignment obj2 1) (vla-put-textstring obj2 txt) (setq en2 (vlax-vla-object->ename obj2)) (setq en3 (entget en2)) (textun) );end of progn );end of if (princ) ) (defun c:UT (/ *error* style1 layer1 size1 col2 col3 en1 en2 en3 type1 ) (setvar "cmdecho" 0) (LM:startundo (LM:acdoc)) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (setvar "cmdecho" 1) (princ) ) (graphscr) ; (setq style1 (getvar "TEXTSTYLE")) ; (setq layer1 (getvar "CLAYER")) ; (setq size1 (GETVAR "TEXTSIZE")) ; (setq col2 (GETVAR "CECOLOR")) ; (setq col3 (atoi COL2)) ;;;SELECT TEXT TO UNDERWRITE (setq en1 (entsel "\n Select the TEXT to write under - ")) (while (= en1 nil) (alert "\n No TEXT selected") (setq en1 (entsel "\n Select the TEXT to write under - ")) );end of while (setq en2 (car en1)) (setq en3 (entget en2)) ;;;CHECK TO SEE IF TEXT OR MTEXT (setq type1 (cdr (assoc 0 en3))) (if (= type1 "MTEXT") (command "DDEDIT" en1 "") (textun) ) ;;;RESET EXISTING VALUES ; (setvar "TEXTSIZE" size1) ; (setvar "TEXTSTYLE" style1) ; (setvar "CLAYER" layer1) ; (setvar "CECOLOR" col2) (setvar "cmdecho" 1) (LM:endundo (LM:acdoc)) (princ) ) (defun c:LH (/ *error* lll osm edp mspace mtext vta tbmtext midpt ) (setvar "cmdecho" 0) (LM:startundo (LM:acdoc)) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (setvar "cmdecho" 1) (princ) ) (graphscr) (setq lll (getvar "clayer")) (setq osm (getvar "osmode")) (command "OSNAP" "INTERSECTION") (command "layer" "m" "GTEXT" "") (setq edp (getpoint "\n pick point for Loft Hatch - ")) ;(command "MTEXT" edp "_Justify" "MC" "_none" "@" "Loft" "hatch" "") (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq mtext (vla-AddMText mspace (vlax-3d-point (trans edp 1 0)) 0 "Loft\nHatch")) (setvar "OSMODE" osm) (command "LAYER" "S" lll "") (setq vta (- 0 (getvar "viewtwist"))) (vla-put-rotation mtext vta) (vla-put-AttachmentPoint mtext acBottomCenter) (setq tbmtext (LM:textbox (entget (vlax-vla-object->ename mtext)))) (setq midpt (mid (car tbmtext) (caddr tbmtext)) ) (vla-move mtext (vlax-3d-point midpt) (vlax-3d-point edp)) (setvar "cmdecho" 1) (LM:endundo (LM:acdoc)) (princ) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) ;; Text Box - Lee Mac (based on code by gile) ;; Returns the bounding box of a text, mtext, or attribute entity (in OCS) ;; enx - [lst] Text, MText or Attribute DXF data list (defun LM:textbox ( enx / bpt hgt jus lst ocs org rot wid ) (cond ( (and (= "ATTRIB" (cdr (assoc 000 enx))) (= "Embedded Object" (cdr (assoc 101 enx))) ) (LM:textbox (cons '(000 . "MTEXT") (member '(101 . "Embedded Object") enx))) ) ( (cond ( (wcmatch (cdr (assoc 000 enx)) "ATTRIB,TEXT") (setq bpt (cdr (assoc 010 enx)) rot (cdr (assoc 050 enx)) lst (textbox enx) lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst))) ) ) ( (= "MTEXT" (cdr (assoc 000 enx))) (setq ocs (cdr (assoc 210 enx)) bpt (trans (cdr (assoc 010 enx)) 0 ocs) rot (angle '(0.0 0.0) (trans (cdr (assoc 011 enx)) 0 ocs)) wid (cdr (assoc 042 enx)) hgt (cdr (assoc 043 enx)) jus (cdr (assoc 071 enx)) org (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid)) (0.0)) (cond ((member jus '(1 2 3)) (- hgt)) ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0)) ) lst (list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt))) ) ) ) ( (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst)) (list (list (cos rot) (sin (- rot)) 0.0) (list (sin rot) (cos rot) 0.0) '(0.0 0.0 1.0) ) ) ) ) ) (princ "\n loading complete") LH's steps are as follows: 1. Create an mtext at the specified point. In this case, the automatically selected MTEXT insertion point is upper left. 2. Rotate by "0 - viewtwist value" to compensate the viewtwist value. 3. Change the attachment point to bottom center. At this point, the position of the text is changed. (not like TJUST command) 4. Find the midpoint of the mtext and move the mtext from midpoint to the specified point step1 without changing the attachment point property. If any of these steps are incorrect, you can correct them. + Line spacing between texts in TT and UT is changed by modifying "1.5" of "(* textsize 1.5)."

(setq e(entget(entlast))) (setq en2(cdr(assoc -1 e))) (setq en3(entget en2)) (SETQ TYPE1 (CDR (ASSOC 0 EN3))) (textun) in TT, this part is just entget entlast. then save type1 ("TEXT" or "MTEXT"), then run the 'textun' (textun) do all of 'insert multiple lines of text equally spaced and centred', except 'at selected point' only. that is TT's work. UT also, entget the TEXT or MTEXT, if that is mtext, just modify with ddedit command, because MTEXT already can make multi lines text if that is text, run the (textun), that will do 'insert multiple lines of text equally spaced and centred'. so, the timing of picking coordinates or making text, which is correct ucs w or ucs p, will know about (textun). I think below code has a sketch of textun as I guessed. try running this TT, UT, LH and again explain which one you want. (DEFUN C:TT (/ *error* ) (setvar "cmdecho" 0) ;(command "ucs" "w") (LM:startundo (LM:acdoc)) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (setvar "cmdecho" 1) ;(command "ucs" "p") (princ) ) (graphscr) (setq lll (getvar "clayer")) (setq osm (getvar "osmode")) (command "osnap" "none") (command "layer" "m" "GTEXT" "") (setq edp (getpoint "\n pick point for first text - ")) (setq txt (getstring t "\n input first text value - ")) (command "TEXT" "C" edp "" 0.0 txt) (setq e (entget (entlast))) (setq en2(cdr(assoc -1 e))) (setq en3(entget en2)) (setq type1 (cdr (assoc 0 en3))) (textun) (setvar "osmode" osm) (command "layer" "S" lll "") (setvar "cmdecho" 1) ;(command "ucs" "p") (LM:endundo (LM:acdoc)) (princ) ) (vl-load-com) (defun textun () (setq txt (getstring t "\n input text - ")) (if (= txt "") (progn (princ "\n end process \n")) (progn (setq textlocation '()) (setq putlocation '()) (setq ss0 (ssadd en2)) (setq lst (LM:textbox en3)) (setq ang (angle (car lst) (last lst))) (setq textsize (cdr (assoc 40 en3))) (setq textlocation (trans (cdr (assoc 10 en3)) 0 1)) (setq ucsang (angle '(0 0) (getvar "ucsxdir"))) (setq ang (- ang ucsang)) (setq putlocation (polar textlocation (+ ang pi) (* textsize 1.5) )) (princ "\n ang - ") (princ ang) (command "copy" ss0 "" textlocation putlocation) (setq ename2 (entlast)) (setq obj2 (vlax-ename->vla-object ename2)) ;(vla-put-alignment obj2 1) (vla-put-textstring obj2 txt) (setq en2 (vlax-vla-object->ename obj2)) (setq en3(entget en2)) (textun) );end of progn );end of if (princ) ) (DEFUN C:UT (/ *error*) (setvar "cmdecho" 0) ;(command "ucs" "w") (LM:startundo (LM:acdoc)) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (setvar "cmdecho" 1) ;(command "ucs" "p") (princ) ) (GRAPHSCR) ;;;EXTRACT EXISTING INFORMATION (SETQ STYLE1 (GETVAR "TEXTSTYLE")) (SETQ LAYER1 (GETVAR "CLAYER")) (SETQ SIZE1 (GETVAR "TEXTSIZE")) (SETQ COL2 (GETVAR "CECOLOR")) (SETQ COL3 (ATOI COL2)) ;;;SELECT TEXT TO UNDERWRITE (SETQ EN1 (ENTSEL "SELECT THE TEXT TO WRITE UNDER: ")) (WHILE (= EN1 NIL) (ALERT "NO TEXT SELECTED") (SETQ EN1 (ENTSEL "SELECT THE TEXT TO WRITE UNDER: ")) ) (SETQ EN2 (CAR EN1)) (SETQ EN3 (ENTGET EN2)) ;;;CHECK TO SEE IF TEXT OR MTEXT (SETQ TYPE1 (CDR (ASSOC 0 EN3))) (IF (= TYPE1 "MTEXT")(COMMAND "DDEDIT" EN1 "")(TEXTUN)) ;;;RESET EXISTING VALUES (SETVAR "TEXTSIZE" SIZE1) (SETVAR "TEXTSTYLE" STYLE1) (SETVAR "CLAYER" LAYER1) (SETVAR "CECOLOR" COL2) (setvar "cmdecho" 1) ;(command "ucs" "p") (LM:endundo (LM:acdoc)) (PRINC) ) (DEFUN C:LH (/ *error*) (setvar "cmdecho" 0) ;(command "ucs" "w") (LM:startundo (LM:acdoc)) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (setvar "cmdecho" 1) ;(command "ucs" "p") (princ) ) (GRAPHSCR) (SETQ lll (GETVAR"CLAYER")) (SETQ OSM (GETVAR"OSMODE")) (COMMAND "OSNAP" "INTERSECTION") (command "layer" "m" "GTEXT" "") (setq edp(getpoint "TEXT AT..")) (COMMAND "MTEXT" edp "_Justify" "MC" "_none" "@" "Loft" "hatch" "") (SETVAR "OSMODE" OSM) (COMMAND "LAYER" "S" lll "") (setq *error* olderr) ; Restore old *error* handler (setvar "cmdecho" 1) ;(command "ucs" "p") (LM:endundo (LM:acdoc)) (princ) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) ;; Text Box - Lee Mac (based on code by gile) ;; Returns the bounding box of a text, mtext, or attribute entity (in OCS) ;; enx - [lst] Text, MText or Attribute DXF data list (defun LM:textbox ( enx / bpt hgt jus lst ocs org rot wid ) (cond ( (and (= "ATTRIB" (cdr (assoc 000 enx))) (= "Embedded Object" (cdr (assoc 101 enx))) ) (LM:textbox (cons '(000 . "MTEXT") (member '(101 . "Embedded Object") enx))) ) ( (cond ( (wcmatch (cdr (assoc 000 enx)) "ATTRIB,TEXT") (setq bpt (cdr (assoc 010 enx)) rot (cdr (assoc 050 enx)) lst (textbox enx) lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst))) ) ) ( (= "MTEXT" (cdr (assoc 000 enx))) (setq ocs (cdr (assoc 210 enx)) bpt (trans (cdr (assoc 010 enx)) 0 ocs) rot (angle '(0.0 0.0) (trans (cdr (assoc 011 enx)) 0 ocs)) wid (cdr (assoc 042 enx)) hgt (cdr (assoc 043 enx)) jus (cdr (assoc 071 enx)) org (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid)) (0.0)) (cond ((member jus '(1 2 3)) (- hgt)) ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0)) ) lst (list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt))) ) ) ) ( (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst)) (list (list (cos rot) (sin (- rot)) 0.0) (list (sin rot) (cos rot) 0.0) '(0.0 0.0 1.0) ) ) ) ) )

@ekko The use of inters is not sensitive to the order of the first two points or final two points for defining the two lines. Be sure to turn off object snap after getting the 4 points! If the lines are always horizontal and vertical then you do not need inters. Then, Intersection point x = p3x or p4x Intersection point y = SPTy or EPTy

I just had what alcoholics refer to as a "moment of clarity" and got it figured out. On the off chance someone else needs it, here it is below. i was not formatting my Z value correctly. it now is formatted as (1 . "ZHEIGHT") which is what the attribute required. (defun c:sdh (/ blks i sn n e) ;;; Set Default Height on all Cap Blocks (if (setq blks (ssget '((0 . "INSERT") (66 . 1)))) (repeat (setq i (sslength blks)) (setq sn (ssname blks (setq i (1- i)))) (setq n (entnext sn)) (while (not (eq (cdr (assoc 0 (setq e (entget n)))) "SEQEND" ) ) (if (eq (cdr (assoc 0 e)) "ATTRIB") (cond ((eq (cdr (assoc 2 e)) "DH") (setq z (cdr(assoc 10 e))) (setq z (caddr z)) (setq z (rtos z 2 6)) (entmod (subst (cons 1 z) (assoc 1 e) e)) ) ) ) (setq n (entnext n)) ) ) ) (princ) )