Leaderboard

Try this one, a different way to MHUPP and just for fun Notes: The font and height used will be as defined in the dimension style and not to any overridden style for that particular dimension entity - I couldn't work out how to do that bit. There is no error checking or checking that you select a dimension, though that is all online If I was taking this further I would round the text point coordinates to the nearest 1.25 units, just because (in case snaps and grid and so are turned off) Need to localise the variables too but try this and see if it mostly works (defun c:GetDimTxt ( / ) (defun createtext ( MyText TextPoint font textheight / ) (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") '(8 . "0") '(100 . "AcDbText") (cons 10 TextPoint) (cons 40 textheight) (cons 1 MyText) '(50 . 0.0) '(41 . 1.0) '(51 . 0.0) (cons 7 font) '(71 . 0) '(72 . 0) '(11 0.0 0.0 0.0) '(210 0.0 0.0 1.0) '(100 . "AcDbText") '(73 . 0) ));end list, entmake ) (defun FindReplace: (Str$ Find$ Replace$ / Cnt# FindLen# Loop Mid$ NewStr$ ReplaceLen#) (setq Loop t Cnt# 1 NewStr$ Str$ FindLen# (strlen Find$) ReplaceLen# (strlen Replace$)) (while Loop (setq Mid$ (substr NewStr$ Cnt# FindLen#)) (if (= Mid$ Find$) (setq NewStr$ (strcat (substr NewStr$ 1 (1- Cnt#)) Replace$ (substr NewStr$ (+ Cnt# FindLen#))) Cnt# (+ Cnt# ReplaceLen#) );setq (setq Cnt# (1+ Cnt#)) );if (if (= Mid$ "") (setq Loop nil)) );while NewStr$ );defun FindReplace: (defun radtodeg( rad / ) (/ (* rad 180.0) pi) ) ;;Get Dimensions Stuff (setq MyDim (entget (car (entsel "Select Dimension")))) (setq DimStyleName (cdr (assoc 3 MyDim))) (setq DimstyleDefinition (tblsearch "DIMSTYLE" DimStyleName)) (setq DimTxtEntity (entget (cdr (assoc 340 DimstyleDefinition))) ) (setq DimType (cdr (assoc 100 (reverse MyDim))) ) (setq DimTxtPos (cdr (assoc 11 MyDim)) ) (setq TextOverride (cdr (assoc 1 MyDim))) (setq MyDimValue (cdr (assoc 42 MyDim))) (setq DimTxtHeight (cdr (assoc 140 DimstyleDefinition))) (setq DimTxtStyle (cdr (assoc 2 DimTxtEntity))) (setq dimensiontypes (list "AcDbAlignedDimension" "AcDbRotatedDimension" "AcDbOrdinateDimension" "AcDsbAngularDimension" "AcsDb2LineAngularDimension" "AcDb3PointAngularDimension" "AscDbDiametricDimension" "AcDbRadialDimension" "AcDbRadialDimensionLarge" "AcDbArcDimension" )) (if (= DimType "AcDb2LineAngularDimension")(setq MyDimValue (radtodeg MyDimValue))) ;;Check text to use (if (= TextOverride "") (setq MyText (rtos MyDimValue)) (setq MyText (FindReplace: TextOverride "<>" (rtos MyDimValue))) ) (setq TextPoint (getpoint DimTxtPos "Select Text Point")) (createtext MyText TextPoint DimTxtStyle DimTxtHeight) )

Here's another way to do it but the end result is MTEXT and you have to pick the text. (defun c:foo (/ e el p1 p2) (if (and (setq e (car (nentsel "\nPick dimension text: "))) (setq p1 (cdr (assoc 10 (setq el (entget e))))) (setq p2 (getpoint p1 "\nSpecify second point: ")) ) (entmakex (append (vl-remove-if '(lambda (x) (= 330 (car x))) el) (list (cons 10 p2)))) ) (princ) )

Another way: (defun c:foo (/ ss) (if (setq ss (ssget '((0 . "*TEXT")))) (print (apply 'max (mapcar '(lambda (x) (atof (cdr (assoc 1 (entget x))))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ) ) ) ) (princ) )

no idea why its working for me and not you guys. took out the vla-copy and just use command --edit @leonucadomi you try Steven's lisp? ;;----------------------------------------------------------------------------;; ;; Copy dimension value to another location (defun C:DimCopy (/ dim BP LastEnt en) (vl-load-com) (setvar 'cmdecho 0) (while (setq dim (car (entsel "\nSelect Dimension: "))) (setq obj (vlax-ename->vla-object dim)) (setq BP (vlax-get obj 'TextPosition)) (setq LastEnt (entlast)) (command "_.Copy" dim "" "_non" BP (getpoint BP "\nCopy to: ")) (command "_Explode" (entlast)) (if (setq en (entnext LastEnt)) (while en (cond ((= "MTEXT" (cdr (assoc 0 (entget en)))) (command "_Explode" en) ;convert mtext to text ) ((= "TEXT" (cdr (assoc 0 (entget en)))) (progn) ) (t (entdel en) ) ) (setq en (entnext en)) ) ) ) (setvar 'cmdecho 1) (princ) )

This is errors before you select a copy to location? Remove BP from getpoint should fix it. (vla-move copy BP (getpoint BP "\nCopy locaiton")) to (vla-move copy BP (getpoint "\nCopy locaiton")) its used to draw a dashed line from the dim you picked like so, but isn't necessary.

defaults to selecting text. Will only ask for input if you don't select anything. (right click / enter) (or (setq obj_sel (nentsel "\nSelect Text [Enter for user input]: ")) (setq get_str (getstring "\nEnter text: ")))

Started with AutoCAD 2019 or 2020 I think.

https://www.theswamp.org/index.php?topic=55172.0 https://www.theswamp.org/index.php?topic=52444.0 And maybe more topics...

Yes, I see... Try (initget 128) before nentsel... It will accept strings too...

Select pline segment. And a label all by Alan Thomson attached. ; Pline segment with angle and length (defun c:plseg() (setq plent (entsel "\nSelect Pline ")) (setvar "osmode" 0) (setq pick (cadr plent) plObj (vlax-ename->vla-object (car plent)) pick2 (vlax-curve-getclosestpointto plobj pick) param (vlax-curve-getparamatpoint plObj pick2) segment (fix param) co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))) (setq pt1 (nth segment co-ord)) (setq pt2 (nth (+ segment 1) co-ord)) (if (= pt2 nil)(setq pt2 (nth 0 co-ord))) (setq len (distance pt1 pt2)) (setq ang (angle pt1 pt2)) (alert (strcat "angle is " (rtos (/ (* ang 180.0) pi) 2 2) " Length is " (rtos len 2 3))) ) label pline segments.lsp

Thanks @tombu for helping and also @mhupp. I'm el stupido. There was bad syntax for the cond section that caused this issue of using the regen command. I only noticed nothing was getting offset when I took this script into work. So the fix is not to be stupid. I think if the regen command is the last call before the while loops again then it breaks the loop. Where I have it positioned in the code works. Strange. entupd didn't work. Related thread about hatching not updating: https://www.theswamp.org/index.php?topic=53010.0 Here's the finished article: There seems to be a bug with the offset selection set passed to LeeMacs offset sub routine but it seems hit and miss for some reason. I will test this at work today and see what gives. ;| ABOUT - Offsets by specified distance and deletes the original but in the case of Polylines it recreates them. This is to preserve the associative hatches if there any. - Distance remembered through different ACAD sessions. Variable saved to the registry. - Non Polyline code done by user ronjonp here: http://www.cadtutor.net/forum/showthread.php?24646-Offset-and-delete-source&p=699122&viewfull=1#post699122 - Polyline recreation code from here: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/replace-polyine-geometry-with-another-polylines-geometry-lisp/m-p/7134030#M354113 - My thread for help here: https://www.cadtutor.net/forum/topic/75500-offset-delete-fixed-with-associated-hatches-minor-problem-hatch-wont-update/ MY EDITS, BY 3dwannab 2018.03.24 - I've added a loop to pick more objects for offset after the first one is completed. and error checking to only select offset-able objects. - It also doesn't fail if nothings selected. 2022.06.25 - Added support to recreate Polyline as the offset position. This will preserve any associative hatches if there any. - Added proper undo handling. 2022.07.13 - Fixed the while loop bug and updating of hatches after each offset. USAGE 'ODEL' or 'OFFSET_DELETE'. |; (defun c:ODEL nil (c:OFFSET_DELETE)) (defun c:OFFSET_DELETE (/ acDoc *error* cordins ent entPlTemp i o offDisStr ptOffside ssOffset ssOrg typ) (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) ) (vla-StartUndoMark (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))) (setq offDisStr (atof (cond ((getenv "MyOffsetProgram")) ("1")))) ;; Get saved offset from registry or default to 1 (while (if (and (setq offDisStr (cond ((getdist (strcat "\nOffset distance <" (vl-princ-to-string offDisStr) ">: "))) (offDisStr))) ;; Prompt for distance, if nil use default (setq ssOrg (LM:ssget "\nSelect object to offset :" '("_:L" ((0 . "*"))))) (setq ptOffside (cond ((getpoint "\nSpecify point on side to offset : ")) ((cadr ssOrg)))) ;; Pick a side to offset or use point in entsel ) ;; If selection is valid (progn (setenv "MyOffsetProgram" (vl-princ-to-string offDisStr)) ;; Write our default offset to registry ;; Loop through each entity in the selection set (repeat (setq i (sslength ssOrg)) (if (and (setq o (vlax-ename->vla-object (ssname ssOrg (setq i (1- i))))) (vlax-method-applicable-p o 'offset) ) ;; Begin offsetting objects (progn (setq e (ssname ssOrg i)) (setq typ (cdr (assoc 0 (entget e)))) ;; Get the type of object, i.e. POLYLINE, LINE etc (setq ssOffset (ssadd)) (setq ssOffset (ssadd e ssOffset)) ;; Offset all other items apart from polylines (cond ((not (wcmatch typ "*POLYLINE")) (lmac-offset ssOffset ptOffside offDisStr) (entdel e) ;; Delete original (entdel won't **** the bed if the object is locked) ) ;; End cond for all but POLYLINES ;; Offset polylines only but recreate them based on the offset polyline verts ((wcmatch typ "*POLYLINE") (lmac-offset ssOffset ptOffside offDisStr) (setq cordins (@Plist (entlast))) ;; Get the coordinates of the offset polyline (setq entPlTemp (entlast)) ;; Set the variable for the newly created temporary entity ;; Put the properties of the new offset polyline to the original one to preserve ;; any associative hatches there may or not be. (if entPlTemp (progn (@put_data (vlax-ename->vla-object e) (@Plist entPlTemp)) (command "._regen") ;; This litle blitter was the fix to update the hatch. I had also ill formatted the cond part and it was breaking the loop (entdel entPlTemp) ;; Delete the temporary polyline ) ) ;; End if entPlTemp ) ;; End cond for POLYLINES ) (ssdel e ssOffset) ;; Delete the entity from the selection set at the end ; sdfas ) ;; end progn for offsetting ) ) ;; end repeat for selection set ) ;; end progn for T if ) ;; End if ) ;; End while ;; This doesn't really do anything outside here as the hatch updates anyway. ;; Having this in the while loop breaks out if the loop so no point it in there either!! ; (vla-Regen acDoc acAllViewports) (vla-EndUndoMark acDoc) (*error* nil) (princ) ) ;; ssget - Lee Mac ;; A wrapper for the ssget function to permit the use of a custom selection prompt ;; msg - [str] selection prompt ;; arg - [lst] list of ssget arguments (defun LM:ssget (msg arg / sel) (princ msg) (setvar 'nomutt 1) (setq sel (vl-catch-all-apply 'ssget arg)) (setvar 'nomutt 0) (if (not (vl-catch-all-error-p sel)) sel) ) ;; Return LWpolyline data in the format. ;; Credit to john.uhden, defun found here: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/replace-polyine-geometry-with-another-polylines-geometry-lisp/m-p/10596684#M419793 ;; '((b1 x1 y1)(b2 x2 y2) ... (bn xn yn)) (defun @Plist (E / plist blist) (setq ent (entget e)) (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) ent))) (setq blist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) ent))) (setq plist (mapcar 'cons blist plist)) ) ;; Apply the collected data from the @Plist function to another LWpolyline. ;; Credit to john.uhden, defun found here: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/replace-polyine-geometry-with-another-polylines-geometry-lisp/m-p/10596684#M419793 ;; where obj is a polyline vla-object (defun @put_data (obj plist / param) (vlax-put obj 'Coordinates (apply 'append (mapcar 'cdr plist))) (setq param 0) ;; parameter index (repeat (length plist) (vla-setbulge obj param (car (nth param plist))) (setq param (1+ param)) ) ) ;; Will Offset a SelSet to the side chosen at distance specified ;; ;; Args: ;; ;; ss ~ SelectionSet ;; ;; pt ~ Point specifying the side to offset ;; ;; dis ~ Distance to Offset ;; ;; Returns: ;; ;; List of Offset Objects ;; (defun lmac-offset (ss pt dis / ent obj l) (vl-load-com) ;; © Lee Mac ~ 25.03.10 ((lambda (i) (cond ((not (and (eq 'PICKSET (type ss)) (numberp dis) (vl-consp pt) ) ) ) ((while (setq ent (ssname ss (setq i (1+ i)))) (if (vlax-method-applicable-p (setq obj (vlax-ename->vla-object ent)) 'Offset ) (mapcar (function vla-delete) (car (setq l (append (vl-sort (mapcar (function (lambda (x) (vlax-invoke obj 'Offset x) ) ) (list dis (- dis)) ) (function (lambda (a b) (> (distance pt (vlax-curve-getClosestPointto (car a) pt)) (distance pt (vlax-curve-getClosestPointto (car b) pt)) ) ) ) ) (cdr l) ) ) ) ) ) ) ) ) ) -1 ) (apply (function append) (cdr l)) ) (princ (strcat "\nOffset_Delete.lsp edited on " (menucmd "m=$(edtime,0,DD-MO-yyyy)") " by 3dwannab (stephensherry147@yahoo.co.uk) loaded" "\nType \"ODEL\" or \"OFFSET_DELETE\" to run Program" ) ) (princ) ; (c:ODEL)

This is the quick and dirty version. no error handling. Copies the whole dimension to the new location. Explodes the copied dimension Erases everything but the MTEXT Explodes Mtext into text don't know if it keeps its style? seems to. ;;----------------------------------------------------------------------------;; ;; Copy dimension value to another location (defun C:DimCopy (/ dim BP LastEnt en) (vl-load-com) (while (setq dim (car (entsel "\nSelect Dimension: "))) (setq dim (vlax-ename->vla-object dim)) (setq BP (vlax-get dim 'TextPosition)) (setq LastEnt (entlast)) (setq copy (vla-copy dim)) (vla-move copy BP (getpoint BP "\nCopy locaiton")) (command "_Explode" (entlast)) (if (setq en (entnext LastEnt)) (while en (cond ((= "MTEXT" (cdr (assoc 0 (entget en)))) (command "_Explode" en) ;convert mtext to text ) ((= "TEXT" (cdr (assoc 0 (entget en)))) (progn) ) (t (entdel en) ) ) (setq en (entnext en)) ) ) ) (princ) )

Try loading and running the attached lisp routine. After loading, just type FLAT at the command prompt and it should work. Flat.lsp

Not sure, have you tried NCOPY command?

You can export them to be 3D Solids in AutoCAD, but you need AutoCAD Architecture. You should have access to the Architectural Toolset, it comes free with AutoCAD. AutoCAD Architecture Toolset Included with Official AutoCAD To Convert Objects to 3D Solid Objects

This is to parse numbers only . (vl-list->string (vl-remove-if-not '(lambda (i) (< 47 i 58)) (vl-string->list "Agl-7.s0@2e:3?(#)8_5F") ) ) Letters only . (vl-list->string (vl-remove-if-not '(lambda (a) (or (< 96 a 123) (< 64 a 91))) (vl-string->list "Agl-7.s0@2e:3?(#)8_5F") ) )