Leaderboard

Often I have to (ok , I want to) edit text (or blocks) directly on screen that are in a sort of table like order. Then it would be nice to be able sort it in rows & columns. In a perfect world all items would be spaced evenly. But we're not living in a perfect world now are we? Besides , that would be boring. Had something like this written a very long time ago but lately needed to be able to see if sorting order was correct before doing my stuff. So also for the fun of it I created mini app to sort things out (but not in my head) Anyways , added routine including a couple of tiny test functions. My own needs are a little bit more complex because need to be able to apply it on (sometimes specific) attributes in blocks too , but I leave the specialities for you little dragons Working is as follows: Select a group of simple text's (you can use attached drawing). The shape of your selection determines if you sort by row or by column (landscape means rows , portrait means columns. It uses the boundary size from 1st item in selection as a fuzz factor , some blocks are a little up , some a little down etc. This you can check by selecting the blocks on the left side of the sample drawing. After you made selection all insertionpoints (or text alignment points) the points are marked with blue number indication their rank on the social ladder. After this I use (grread) in a loop where you can use Tab to switch between ByRow & ByColumn , Spacebar to cycle in which Quadrant to start numbering and Enter means you're a happy human of planet earth. (C:t1) just shows you the list , (C:t2) you can replace the texts with another string. Rlx-Sort-SS.dwg RlxSortSS.lsp

like this? ; (SplitStr "a,b" ",") -> ("a" "b") (defun SplitStr (s d / p) (if (setq p (vl-string-search d s))(cons (substr s 1 p)(SplitStr (substr s (+ p 1 (strlen d))) d))(list s))) (nth 2 (splitstr "-1|NCC|2.54|30|0|Auto|0|1|0|2|0|0|2|0|False|0|0" "|"))

Remove brackets from arguments in delta functions (rtos (sqrt (+ (sqr (dX p1 p2)) (sqr (dY p1 p2)))))

OP sent me a private message with his (broken) code so far and there I also found this code "\\nbladiebla". This would only produce "\nbladiebla". Only if you would want to princ 2 lines , on the first line a \ and the second line bladiebla you would use (princ "\\\nbladibla") But especially in the context of OP's program this makes no sense at all , so whether it's a typo or a search and replace horribly go wrong , lets purge this from our brain cells , preferably with lots of beer (or babymilk , whatever) and for now don't PM me unless for dirty pictures or something because I don't have the time to be your private dancer (Tina Turner) , its 01.30 am and I have to present a new app (automatic instrument loop checker , dbx) at 08.30 am and it's not finished yet so this is gonna be an all nighter , bummers

\\n because a single \ is a control character in a string, to write a single \ to the text file you need to add \ (control character) and \ (character you want to use) - special case for \ that you have to specify you want to use it as a \

to get you started ;;; written for rdx 2024-07-12 (defun c:rdx ( / dcl-fp dcl-fn dcl-id continu) (vl-load-com) (rdx_write_dialog) (rdx_start_dialog) (princ (strcat "\nValue of continue last selection : " (vl-princ-to-string continu))) (princ) ) (defun rdx_write_dialog ( ) (if (and (setq dcl-fn (vl-filename-mktemp "tmp" "" ".dcl")) (setq dcl-fp (open dcl-fn "w"))) (mapcar '(lambda (x)(write-line x dcl-fp)) (list "tccz : dialog {" " label=\"Layer Operations\";" " :row{" " :button{label=\"object select\";key=\"object_select\";is_default=true;fixed_width=true;width=4;}" " :button{label=\"Dim Select\";key=\"notuxian\";fixed_width=true;width=4;}" " }" " :row{" " :button{label=\"Isolate Select\";key=\"geli\";fixed_width=true;width=4;}" " :button{label=\"Close Select\";key=\"nogeli\";fixed_width=true;width=4;}" " }" " :row{" " :button{label=\"Lock Select\";key=\"suoding\";fixed_width=true;width=4;}" " :button{label=\"Lock Unselect\";key=\"nosuoding\";fixed_width=true;width=4;}" " }" " :row{" " :button{label=\"Freeze Select\";key=\"dongjie\";fixed_width=true;width=4;}" " :button{label=\"Freeze Unselect\";key=\"nodongjie\";fixed_width=true;width=4;}" " }" " :row{" " :text{value=\"when the command is first executed\";is_enabled=true;fixed_width=true;width=29;fixed_height=true;height=0;}" " }" " :row{" " :button{label=\"Color uniformity\";key=\"bylayer\";fixed_width=true;width=4;}" " :button{label=\"Restore\";key=\"huifu\";fixed_width=true;width=4;}" " }" " :row{" " :button{label=\"Layer Management\";key=\"state\";fixed_width=true;width=4;}" " :button{label=\"cancel\";key=\"cancel\";is_cancel=true;fixed_width=true;width=14;fixed_height=true;height=1;is_enabled=true;}" " }" " :toggle{label=\"Continue last status\";key=\"continu\";fixed_width=true;width=4;}" " }" ) ) ) (if dcl-fp (progn (close dcl-fp)(gc))) ) (defun rdx_start_dialog ( / rtn ) (if (and (< 0 (setq dcl-id (load_dialog dcl-fn))) (new_dialog "tccz" dcl-id)) (progn (action_tile "cancel" "(done_dialog 0)") (action_tile "accept" "(done_dialog 1)") (action_tile "object_select" "(alert \"object select\")(done_dialog 2)") (action_tile "notuxian" "(alert \"Dim Select\")(done_dialog 3)") (action_tile "geli" "(alert \"Isolate Select\")(done_dialog 4)") (action_tile "nogeli" "(alert \"Close Select\")(done_dialog 5)") (action_tile "suoding" "(alert \"Lock Select\")(done_dialog 6)") (action_tile "nosuoding" "(alert \"Lock Unselect\")(done_dialog 7)") (action_tile "dongjie" "(alert \"Freeze Select\")(done_dialog 8)") (action_tile "nodongjie" "(alert \"Freeze Unselect\")(done_dialog 9)") (action_tile "bylayer" "(alert \"Color uniformity\")(done_dialog 10)") (action_tile "huifu" "(alert \"Restore\")(done_dialog 11)") (action_tile "state" "(alert \"Layer Management\")(done_dialog 12)") (action_tile "continu" "(setq continu $value)") (setq rtn (start_dialog)) (unload_dialog dcl-id) (vl-file-delete dcl-fn) ) (princ "\nUnable to start dialog") ) (if (null continu)(setq continu "0")) (cond ((= rtn 0) (princ "\nYou clicked on cancel")) ((= rtn 1) (princ "\nYou clicked on ok")) ((= rtn 2) (object_select)) ((= rtn 3) (notuxian)) ((= rtn 4) (geli)) ((= rtn 5) (nogeli)) ((= rtn 6) (suoding)) ((= rtn 7) (nosuoding)) ((= rtn 8) (dongjie)) ((= rtn 9) (nodongjie)) ((= rtn 10) (bylayer)) ((= rtn 11) (huifu)) ((= rtn 12) (state)) ) ) (defun object_select ()(alert "under construction - object_select")) (defun notuxian ()(alert "under construction - notuxian")) (defun geli ()(alert "under construction - geli")) (defun nogeli ()(alert "under construction - nogeli")) (defun suoding ()(alert "under construction - suoding")) (defun nosuoding ()(alert "under construction - nosuoding")) (defun dongjie ()(alert "under construction - dongjie")) (defun nodongjie ()(alert "under construction - nodongjie")) (defun bylayer ()(alert "under construction - bylayer")) (defun huifu ()(alert "under construction - huifu")) (defun state ()(alert "under construction - state")) alternative for your dcl code : (defun rdx_write_dialog ( ) (if (and (setq dcl-fn (vl-filename-mktemp "tmp" "" ".dcl")) (setq dcl-fp (open dcl-fn "w"))) (mapcar '(lambda (x)(write-line x dcl-fp)) (list "tccz : dialog {label=\"Layer Operations\";" ":boxed_row {label=\"Select layer operation : \";" ":column {:bt {label=\"Object Select\";key=\"object_select\";}:bt {label=\"Isolate Select\";key=\"geli\";}" ":bt {label=\"Lock Select\";key=\"suoding\";}:bt {label=\"Freeze Select\";key=\"dongjie\";}}" ":column {:bt {label=\"Dim Select\";key=\"notuxian\";}:bt {label=\"Close Select\";key=\"nogeli\";}" ":bt {label=\"Lock Unselect\";key=\"nosuoding\";}:bt {label=\"Freeze Unselect\";key=\"nodongjie\";}}}" "spacer;" ":boxed_row {label=\"When the command is first executed : \";" ":column {:bt {label=\"Layer Management\";key=\"state\";}:bt {label=\"Restore\";key=\"huifu\";}}" ":column {:bt {label=\"Color Uniformity\";key=\"bylayer\";}:bt {label=\"Future\";key=\"future\";}}}" ":toggle {label=\"Continue last status\";key=\"continu\";}spacer;ok_cancel;}" "bt :button {width=26;fixed_width=true;}" ) ) ) (if dcl-fp (progn (close dcl-fp)(gc))) )

This is partly a data problem. You might be able to create a dynamic block, which you can move and scale to fit the various sizes of column (or footing or whatever). The block contains attributes for each piece of data, which you can read/export fairly easily. It's also easy to select a specific type of block, put them in a set, and process each one. It's also partly a drafting problem. With different lengths for the codes, it's hard to use separate attributes, because they'll overlap. You could include code to input/validate and output/filter a group of codes, but there's no way to prevent someone from manually breaking your system. I can't tell what the "position numbers" mean, so I can't tell you how to generate them. There is software out there for drawing and labeling rebar. Some of them cost money. I don't know if you can generate the labels the way you need to, or if there's a way to customize them. AutoLISP has the benefit of being free (apart from the time you spend writing and debugging it), and it's infinitely customizable.

I was looking for the original on Cadalyst, but this appears to be an update to that one. Make a New Linetype with Text Here is the latest on Cadalyst. There is another out there called LtFly.

A linetype can be read from a .lin file no need for code. *HOT_WATER_SUPPLY,Hot water supply ---- HW ---- HW ---- HW ---- A,12.7,-5.08,["HW",STANDARD,S=2.54,R=0.0,X=-2.54,Y=-1.27],-5.08 We had custom.lin with lots of linetypes and would preload into our dwt so ready to go. Or Linetype Load 1 or more linetype into a dwg. ;load missing linetypes ;;; returns: T if loaded else nil (loadLinetype doc "Fence" "custom.lin") (loadLinetype doc "Tree" "custom.lin") (setq doc (vla-get-activedocument (vlax-get-acad-object))) ; open database (defun loadLinetype (doc LineTypeName FileName) (if (and (not (existLinetype doc LineTypeName)) (vl-catch-all-error-p (vl-catch-all-apply 'vla-load (list (vla-get-Linetypes doc) LineTypeName FileName ) ) ) ) nil T ) ) (defun existLinetype (doc LineTypeName / item loaded) (vlax-for item (vla-get-linetypes doc) (if (= (strcase (vla-get-name item)) (strcase LineTypeName)) (setq loaded T) ) ) )

oh, found a function of Lee Mac that does exactly what i want.

Code 43 is for global width .. you can also entmod the items without the need to create the layer: (defun c:foo (/ s) (if (setq s (ssget "_X" '((0 . "*POLYLINE") (43 . 0.)))) (foreach e (mapcar 'cadr (ssnamex s)) (entmod (append (entget e) '((8 . "vm_symb_kont"))))) ) (princ) ) You could also use this filter but it only guarantees that the first occurrence is = 0, others could be different. (setq s (ssget "_X" '((0 . "*POLYLINE") (40 . 0.))))

Here's another: (mapcar 'vl-princ-to-string (read (strcat "(" (vl-string-translate "|" " " "-1|NCC|2.54|30|0|Auto|0|1|0|2|0|0|2|0|False|0|0") ")") ) ) ;; ("-1" "NCC" "2.54" "30" "0" "AUTO" "0" "1" "0" "2" "0" "0" "2" "0" "FALSE" "0" "0")

Hi there... I think I've solved hatching for squares - box 0,0 - 1,1 with density 0.001... This means 1000x1000 precision... All I did is I changed Factor from 100 to 1000 and fuzzines from 0.01 to 0.001, or from 0.001 to 0.0001, or from 0.0001 to 0.00001... So, you actually don't even have to snap to snaps - you just draw your pattern and when finished you use (c:round) with tolerance : 0.001... Here are the routines... ;;;CADALYST 10/05 Tip 2065: HatchMaker.lsp Hatch Maker (c) 2005 Larry Schiele ;;;* ====== B E G I N C O D E N O W ====== ;;;* HatchMaker.lsp written by Lanny Schiele at TMI Systems Design Corporation ;;;* Lanny.Schiele@tmisystems.com ;;;* Tested on AutoCAD 2002 & 2006. -- does include a 'VL' function -- should work on Acad2000 on up. (defun C:DrawHatch nil (vl-cmdf "_.UNDO" "_BE") (setq os (getvar "OSMODE")) (setvar "OSMODE" 0) (vl-cmdf "_.UCS" "_W") (vl-cmdf "_.PLINE" "0,0" "0,1" "1,1" "1,0" "_C") (vl-cmdf "_.ZOOM" "_C" "0.5,0.5" 1.1) (setvar "OSMODE" os) (setvar "SNAPMODE" 1) (setvar "SNAPUNIT" (list 0.001 0.001)) (vl-cmdf "_.UNDO" "_E") (alert "Draw pattern within 1x1 box using LINE or POINT entities only...") (alert "When you finished drawing pattern in box 0,0 - 1,1; use (c:round) routine to round entities to nearest 0.001 - that should be your tolerance...") (princ) ) (defun C:SaveHatch ( / round dxf ListToFile user SelSet SelSetSize ssNth Ent EntInfo EntType pt1 pt2 Dist AngTo AngFrom XDir YDir Gap DeltaX DeltaY AngZone Counter Ratio Factor HatchName HatchDescr FileLines FileLines FileName Scaler ScaledX ScaledY RF x y h _AB _BC _AC _AD _DE _EF _EH _FH DimZin ) ;;;* BEGIN NESTED FUNCTIONS (defun round (num) (if (>= (- num (fix num)) 0.5) (fix (1+ num)) (fix num) ) ) (defun dxf (code EnameOrElist / VarType) (setq VarType (type EnameOrElist)) (if (= VarType (read "ENAME")) (cdr (assoc code (entget EnameOrElist))) (cdr (assoc code EnameOrElist)) ) ) (defun ListToFile (TextList FileName DoOpenWithNotepad AsAppend / TextItem File RetVal) (if (setq File (open FileName (if AsAppend "a" "w"))) (progn (foreach TextItem TextList (write-line TextItem File) ) (setq File (close File)) (if DoOpenWithNotepad (startapp "notepad" FileName) ) ) ) (FindFile FileName) ) ;;;* END NESTED FUNCTIONS (princ (strcat "\n." "\n 0,1 ----------- 1,1" "\n | | " "\n | Lines and | " "\n | points must | " "\n | be snapped | " "\n | to nearest | " "\n | 0.001 | " "\n | | " "\n 0,0 ----------- 1,0" "\n." "\nNote: Lines must be drawn within 0,0 to 1,1 and lie on a 0.001 grid." ) ) (textscr) (getstring "\nHit [ENTER] to continue...") (princ "\nSelect 1x1 pattern of lines and/or points for new hatch pattern...") (while (not (setq SelSet (ssget (list (cons 0 "LINE,POINT")))))) (setq ssNth 0 SelSetSize (sslength SelSet) DimZin (getvar "DIMZIN") ) (setvar "DIMZIN" 11) (if (> SelSetSize 0) (princ "\nAnalyaing entities...") ) (while (< ssNth SelSetSize) (setq Ent (ssname SelSet ssNth) EntInfo (entget Ent) EntType (dxf 0 EntInfo) ssNth (+ ssNth 1) ) (cond ( (= EntType "POINT") (setq pt1 (dxf 10 EntInfo) FileLine (strcat "0," (rtos (car pt1) 2 6) "," (rtos (cadr pt1) 2 6) ",0,1,0,-1") ) (princ (strcat "\n" FileLine)) (setq FileLines (cons FileLine FileLines)) ) ( (= EntType "LINE") (setq pt1 (dxf 10 EntInfo) pt2 (dxf 11 EntInfo) Dist (distance pt1 pt2) AngTo (angle pt1 pt2) AngFrom (angle pt2 pt1) IsValid nil ) (if (or (equal (car pt1) (car pt2) 0.00001) (equal (cadr pt1) (cadr pt2) 0.00001) ) (setq DeltaX 0 DeltaY 1 Gap (- Dist 1) IsValid T ) (progn (setq Ang (if (< AngTo pi) AngTo AngFrom) AngZone (fix (/ Ang (/ pi 4))) XDir (abs (- (car pt2) (car pt1))) YDir (abs (- (cadr pt2) (cadr pt1))) Factor 1 RF 1 ) (cond ( (= AngZone 0) (setq DeltaY (abs (sin Ang)) DeltaX (abs (- (abs (/ 1.0 (sin Ang))) (abs (cos Ang)))) ) ) ( (= AngZone 1) (setq DeltaY (abs (cos Ang)) DeltaX (abs (sin Ang)) ) ) ( (= AngZone 2) (setq DeltaY (abs (cos Ang)) DeltaX (abs (- (abs (/ 1.0 (cos Ang))) (abs (sin Ang)))) ) ) ( (= AngZone 3) (setq DeltaY (abs (sin Ang)) DeltaX (abs (cos Ang)) ) ) ) (if (not (equal XDir YDir 0.0001)) (progn (setq Ratio (if (< XDir YDir) (/ YDir XDir) (/ XDir YDir)) RF (* Ratio Factor) Scaler (/ 1 (if (< XDir YDir) XDir YDir)) ) (if (not (equal Ratio (round Ratio) 0.0001)) (progn (while (and (<= Factor 1000) (not (equal RF (round RF) 0.0001)) ) (setq Factor (+ Factor 1) RF (* Ratio Factor) ) ) (if (and (> Factor 1) (<= Factor 1000)) (progn (setq _AB (* XDir Scaler Factor) _BC (* YDir Scaler Factor) _AC (sqrt (+ (* _AB _AB) (* _BC _BC))) _EF 1 x 1 ) (while (< x (- _AB 0.5)) (setq y (* x (/ YDir XDir)) h (if (< Ang (/ pi 2)) (- (+ 1 (fix y)) y) (- y (fix y)) ) ) (if (< h _EF) (setq _AD x _DE y _AE (sqrt (+ (* x x) (* y y))) _EF h ) ) (setq x (+ x 1)) ) (if (< _EF 1) (setq _EH (/ (* _BC _EF) _AC) _FH (/ (* _AB _EF) _AC) DeltaX (+ _AE (if (> Ang (/ pi 2)) (- _EH) _EH)) DeltaY (+ _FH) Gap (- Dist _AC) IsValid T ) ) ) ) ) ) ) ) (if (= Factor 1) (setq Gap (- Dist (abs (* Factor (/ 1 DeltaY)))) IsValid T ) ) ) ) (if IsValid (progn (setq FileLine (strcat (angtos AngTo 0 6) "," (rtos (car pt1) 2 8) "," (rtos (cadr pt1) 2 8) "," (rtos DeltaX 2 8) "," (rtos DeltaY 2 8) "," (rtos Dist 2 8) "," (rtos Gap 2 8) ) ) (princ (strcat "\n" FileLine)) (setq FileLines (cons FileLine FileLines)) ) (princ (strcat "\n * * * Line with invalid angle " (angtos AngTo 0 6) (chr 186) " omitted. * * *")) ) ) ( (princ (strcat "\n * * * Invalid entity " EntType " omitted.")) ) ) ) (setvar "DIMZIN" DimZin) (if (and FileLines (setq HatchDescr (getstring T "\nBriefly describe this hatch pattern: ")) (setq FileName (getfiled "Hatch Pattern File" (strcat (getvar (quote roamablerootprefix)) "support\\") "pat" 1)) ) (progn (if (= HatchDescr "") (setq HatchDescr "Custom hatch pattern") ) (setq HatchName (vl-filename-base FileName) FileLines (cons (strcat "*" HatchName "," HatchDescr) (reverse FileLines)) ) (princ "\n============================================================") (princ (strcat "\nPlease wait while the hatch file is created...\n")) (ListToFile FileLines FileName nil nil) (while (not (findfile FileName))) ; (vl-cmdf "delay" 1500) ; delay required so file can be created and found (silly, but req.) (if (findfile FileName) (princ (strcat "\nHatch pattern '" HatchName "' is ready to use!")) (progn (princ "\nUnable to create hatch pattern file:") (princ (strcat "\n " FileName)) ) ) ) (princ (if FileLines "\nCancelled." "\nUnable to create hatch pattern from selected entities.")) ) (princ) ) ;| (princ "\n ************************************************************** ") (princ "\n** **") (princ "\n* HatchMaker.lsp written by Lanny Schiele -- enjoy! *") (princ "\n* *") (princ "\n* Type in DRAWHATCH to have the environment created to draw. *") (princ "\n* Type in SAVEHATCH to save the pattern you created. *") (princ "\n** **") (princ "\n ************************************************************** ") (princ) |; (defun c:round ( / rounddxf roundvalue round e i k l m s ) (defun rounddxf ( key mod lst / rtn ) (foreach itm lst (if (member (car itm) key) (setq rtn (cons (cons (car itm) (roundvalue (cdr itm) mod)) rtn)) (setq rtn (cons itm rtn)) ) ) (reverse rtn) ) (defun roundvalue ( val mod ) (if (listp val) (mapcar (function (lambda ( x ) (round x mod))) val) (round val mod) ) ) ;; Doug Broad (defun round ( value to ) (setq to (abs to)) (* to (fix (/ ((if (minusp value) - +) value (* to 0.5)) to))) ) (setq l '( ("CIRCLE" 10 40) ("LINE" 10 11) ("LWPOLYLINE" 10) ("INSERT" 10) ("POINT" 10) ) ) (if (null *tol*) (setq *tol* 5.0) ) (initget 6) (if (setq m (getreal (strcat "\nSpecify rounding tolerance <" (rtos *tol*) ">: "))) (setq *tol* m) (setq m *tol*) ) (if (setq s (ssget "_:L" '((0 . "CIRCLE,LINE,LWPOLYLINE,INSERT,POINT")))) (repeat (setq i (sslength s)) (if (setq e (entget (ssname s (setq i (1- i)))) k (cdr (assoc (cdr (assoc 0 e)) l))) (entmod (rounddxf k m e)) ) ) ) (princ) ) HTH. M.R. sups-nn.pat

@Steven P if you use "A" append option for a file then can add a new linetype to a "lin' file, would check 1st does name exist ?

sq mm to sq m is just a division. (/ 234234234 1e6) 234.234234 (/ 234234234 1000000) 234 (/ 224234234 1000000.) 224.234234 (setq str (strcat "Area is " (rtos area 2 2) "m" (chr 178))) "Area is 123.45m²" The chr 178 can be different in some text fonts.

Please have a look at the youtube it talks about how to convert same type objects to a block. The second dwg is fine as it has blocks for the clamps. But no sleeper out line. Sleeper-4 is different again, so a new code again. Please see PM as we can discuss off the forum while we go back and forth.

you can use (cvunit asum "sq_mm" "sq_m") to convert it. Additionally you could read insunits to check if that unit is actually used. (defun c:BB ( / ss index asum e obj tmparea msp spt txtobj dwgunit) (if (setq ss (ssget (list (cons 0 "CIRCLE,ARC,LWPOLYLINE,ELLIPSE,SPLINE")))) (progn (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq index 0 asum 0) (repeat (sslength ss) (setq e (ssname ss index)) (setq obj (vlax-ename->vla-object e)) (setq tmparea (vla-get-area obj)) (setq asum (+ asum tmparea)) (setq index (1+ index)) ) (if (not (setq dwgunit (cdr (assoc (getvar "insunits") '((4 . "sq_mm")(5 . "sq_cm")(6 . "sq_m")))))) (progn (princ "\nError with dwg unit")(exit))) (setq asum (cvunit asum dwgunit "sq_m")) (prompt (strcat "\nTotal area = " (rtos asum 2 2) " m²")) (initget 1) (setq spt (getpoint "\nText start point: ")) (setq txtobj (vla-addtext msp (strcat (rtos asum 2 2) " m²") (vlax-3d-point spt) (getvar "textsize"))) ) ) (princ) )

You are right the selection set will select all polylines with a width of 0. I'd select this first as a variable: (setq MySS (ssget "_X" (list (cons 0 "*POLYLINE")(cons -4 ">")(cons 40 0.0))) ) Then you need to do something with it. The report you are getting "<Selection Set: 3>" where 3 is the selection set name (specific to that running of the LISP). LISP doesn't know what to do next. You might want something like this to change the selection set to that layer: (command "chprop" MySS "" "LAYER" "-YOUR LAYER NAME-" "")

Understand but my V20 Bricscad does not support "CO".

Look at post above and this (tblsearch "dimstyle" "TESTDIM50")

I just look at each sleeper in UCS World, the secret is two things is it CW or CCW and I have set the pline points so 1st point is lower left. For right hand dual rails the corner point would be top left and offsets as -ve as per your request. I take into account sleeper may be rotated but offsets are from a corner. Working on it maybe tomorrow for code, have the get X&Y working next step is do Excel. I used Bricscad Blockify to turn the "T" into a block will see if 2025 supports that otherwise have to do the find common point of the 3 lines.

That's usually the case!

If you plan on doing university for architecture, you will probably have a good chance of landing employment, check with the university, lots of companies get students to work for them on a full time and/or part time basis, at least here in the USA. Getting some online experience and working through tutorials, etc. plus showing you are doing the schooling for a degree in architecture would go a long way toward getting hired. I am completely self taught for AutoCAD as well as 3D CAD and modeling, though I have a mechanical degree and started on board drafting, I started out working in machine shops and doing fabrication and welding. Forums like CADTutor, Autodesk and others are great for help when you hit any roadblocks along the way.

Go a I7 and look for say a NVIDIA graphics card, maybe look at a AMD offering. We at one stage had to replace computers when we did a Acad upgrade as the inbuilt Intel graphics was a problem.

You may be better using a entmake to create your style. 2 examples. You can do this as a defun for multiple dimstyles just set the variable to a value eg (cons 2 dname) (if (not (tblsearch "dimstyle" "TA-DIM-60")) (entmake (list (cons 0 "DIMSTYLE") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbDimStyleTableRecord") (cons 2 "TA-DIM-60") (cons 70 0) (cons 7 "Arial") (cons 40 1.0) (cons 41 2.0) (cons 46 2) (cons 140 2.5) (cons 340 (tblobjname "Style" "Arial")) ) ) ) You dont have to have every single property. (entmake (list (cons 0 "DIMSTYLE") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbDimStyleTableRecord") (cons 2 Dim_Name) ;Dim style name (cons 70 0) ; Standard flag (cons 3 " [m]"); DIMPOST (cons 4 ""); DIMAPOST (cons 5 DIMBLK-Name) ;DIMBLK-Name of block instead of default arrowhead (cons 6 DIMBLK-Name);(cons 6 "ClosedFilled"); DIMBLK1 (cons 7 "Standard") ; text style name (cons 170 0) ;DIMALT-turns off alternate units (cons 40 dimscale) ;DIMSCALE-sets the overall scale factor applied to all dimensions (cons 41 Arrow_Size) ;DIMASZ-sets the size of the arrow/tick (cons 42 Extension_Line_Origin_Offset); DIMEXO (cons 43 Dimension_Line_Spacing); DIMDLI (cons 44 Extension_Above_Dimension_Line) ;DIMEXE-specifies how far to extend the extention line beyound the dim line (cons 45 0.0); DIMRND (cons 46 0) ;DIMDLE-sets the distance the dimension line extends beyond the extension line (cons 47 0.0); DIMTP (cons 48 0.0); DIMTM (cons 71 0); DIMTOL (cons 72 0); DIMLIM (cons 73 0) ;DIMTIH-controls the position of dimension text inside extention lines ;METTE IL TESTO DI QUOTA ORIZZONTALE (cons 74 0) ;DIMTOH-controls the position of dimension text outside extention lines (cons 75 1); DIMSE1 ;1 sopprime la linea di estensione, 0 la lascia (cons 76 1); DIMSE2 ;1 sopprime la linea di estensione, 0 la lascia (cons 77 1) ;DIMTAD-controls the vertical position of text in relation to the dim line (cons 78 3) ;DIMZIN-controls the suppression of zeros (cons 79 1); DIMAZIN (cons 140 Text_Height) ;DIMTXT-specifies the height of the text in the dim (cons 141 Center_Mark_Size); DIMCEN (cons 142 0.0); DIMTSZ (cons 143 0.5) ;DIMALTF-controls the scale factor for alt. units (cons 144 quote_scale); DIMLFAC ;scala di quota (cons 145 0.0); DIMTVP (cons 146 0.64); DIMTFAC (cons 147 Gap_From_dimension_Line_to_Text) ;DIMGAP-sets the distance from around the dim text (cons 170 0); DIMALT (cons 171 2) ;DIMALTD-controls the decimal places for units (cons 172 0) ;DIMTOFL-forces a line inside extension lines (cons 173 1); DIMSAH (cons 174 0); DIMTIX (cons 175 0); DIMSOXD (cons 176 256); DIMCLRD (cons 177 256); DIMCLRE (cons 178 256); DIMCLRT color of text (cons 179 0); DIMADEC (cons 270 2) ;DIMUNIT-sets the units format for all dims ;2 decimale ; 4architettonico (cons 271 Decimal_Places) ;DIMDEC-sets the number of decimal places of primary units (cons 272 Tolerance_Decimal_places); DIMTDEC (cons 273 2) ;DIMALTU-sets the units for alt. units (cons 275 0) ;DIMAUNIT-sets the angular format for angular dims (cons 276 1); DIMFRAC (cons 277 2); DIMLUNIT ;2 decimale ; 4architettonico (cons 278 0); DIMDSEP (cons 279 Text_Movement); DIMTMOVE (cons 280 0) ;DIMJUST-controls the horizontal positioning of dim text (cons 281 -1); DIMSD1 (cons 282 -1); DIMSD2 (cons 283 1); DIMTOLJ (cons 284 3); DIMTZIN (cons 285 1); DIMALTZ (cons 286 0) ;DIMALTTZ-Toggles the suppression in tolerance values ;(cons 287 0); DIMFIT ;(cons 288 0); DIMUPT ;(cons 289 0); DIMATFIT (cons 340 (tblobjname "style" "Estilo_Cotas")); DIMTXSTY ;(cons 341 (cdr (assoc 330 (entget (tblobjname "block" "."))))); DIMLDRBLK ;(cons 342 (cdr (assoc 330 (entget(tblobjname "block" "_Oblique"))))); DIMBLK must setvar dimblk 1st ;(cons 343 (cdr (assoc 330 (entget(tblobjname "block" "_Oblique"))))); DIMBLK1 ;(cons 344 (cdr (assoc 330 (entget(tblobjname "block" "_Oblique"))))); DIMBLK2 ;(cons 371 -2); DIMLWD ;(cons 372 -2); DIMLWE ) )

You could look at Lee Macs string to List function, use the | character as the deliminator: https://lee-mac.com/stringtolist.html (almost the same as what RLX has)

The string-handling functions in AutoLISP are not the best. car won't help unless you have a list. So let's make a list. Add quotes at beginning and end. Replace each pipe with quote-space-quote. Pull out the third element. Done.

1:85 is not a normal metric scale 1:50 or 1:100 would be a ore correct scale.

Those objects will not be within the tolerance distance of 0.25 that the code uses. Front view of circle ( blue ) and 3dpolys ( red ).

Here's one that will extend lines to circles and plines that are at the same elevation. (defun c:foo (/ bndry bndrys d d2 el fz lines lo p p p1 p2 p3 s z) (cond ((setq s (ssget ":L" '((0 . "CIRCLE,LINE,LWPOLYLINE")))) (setq fz 0.25) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (if (= "LINE" (cdr (assoc 0 (setq el (entget e))))) (setq lines (cons (list e (cdr (assoc 10 el)) (cdr (assoc 11 el))) lines)) (setq bndrys (cons e bndrys)) ) ) (foreach line lines (foreach b bndrys (setq p (vlax-curve-getclosestpointto b (cadr line))) (setq p2 (vlax-curve-getclosestpointto b (caddr line))) (setq d (distance p (cadr line))) (setq d2 (distance p2 (caddr line))) (setq z (cond ((and (<= d d2) (<= d fz)) 'startpoint) ((and (<= d2 d) (<= d2 fz)) 'endpoint) ) ) (cond (z (setq lo (vlax-ename->vla-object (car line))) (if (setq p3 (vlax-invoke lo 'intersectwith (vlax-ename->vla-object b) 1)) (vlax-put lo z (if (< (distance (mapcar '+ p3 '(0 0 0)) p) (distance (mapcar '+ (cdddr p3) '(0 0 0)) p) ) (mapcar '+ p3 '(0 0 0)) (mapcar '+ (cdddr p3) '(0 0 0)) ) ) ) ) ) ) ) ) ) (princ) )

It sounds like your model space drawing units is set to meters not millimeters for starters.

"Breakall.lsp" by CAB on the last post there is an update by 3dwannab Here is an updated version by marko_ribar BreakObjects.lsp - Programs and Scripts - AutoCAD Forums (cadtutor.net) As mentioned by BIGAL, there are some around for wipeouts and placing arcs, etc. Here is a start as well as Lee Mac's Automatic Block Break | Lee Mac Programming (lee-mac.com)

Based on what your drawing shows. I recommend that you look at this program from Lee Mac: https://www.lee-mac.com/objectbreak.html At the top of the program file, you can set the layer properties of the changed portions of the objects.

If the user has to provide the points, can't you just use the PLine command? Or call it with the AutoLISP command command? What am I missing?

Try this. Note your values in sample did not match the Excel values added more. ; https://www.cadtutor.net/forum/topic/87091-changing-dynamic-block-attribute-value-from-excel/ (defun c:ex2atts (/ row column lst x atts att obj st end) (if (not ColumnRow)(load "alan excel library3")) (getrangexl) (setq row 2 column (cadr end) lst '()) (repeat (- (car end) 1) (setq lst (cons (list (getcell2 row (- column 1))(getcell2 row column)) lst)) (setq row (1+ row)) ) (setq ss (ssget '((0 . "INSERT")(66 . 1)))) (repeat (setq x (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) (setq atts (vlax-invoke obj 'Getattributes)) (foreach att atts (if (= (vlax-get att "tagstring") "REF") (progn (setq val (vlax-get att 'textstring)) (foreach lstval lst (if (= (car lstval) val) (vlax-put att 'Textstring (cadr lstval)) ) ) ) ) ) ) (princ) ) (c:ex2atts)

@Noor-Cad Give this a try. It will maintain the differing Z vales of your text. (defun c:foo (/ ln o p pl s txt) ;; RJP » 2024-06-24 (cond ((setq s (ssget ":L" '((0 . "*TEXT,LWPOLYLINE")))) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (if (= "AcDbPolyline" (vla-get-objectname (setq o (vlax-ename->vla-object e)))) (setq pl o) (setq txt (cons (list o (vlax-get o 'textalignmentpoint)) txt)) ) ) (if pl (foreach tx txt (setq ln (entmakex (list '(0 . "LINE") (cons 10 (cadr tx)) (cons 11 (mapcar '+ (cadr tx) '(0 1 0))) '(8 . "TEMPLINE") ) ) ) (vla-put-elevation pl (last (cadr tx))) (if (setq p (vlax-invoke (vlax-ename->vla-object ln) 'intersectwith pl 3)) (progn (vlax-put (car tx) 'textalignmentpoint p) (entdel ln)) ) ) ) ) ) (princ) )

Two other ways (command "LINE" p1 (mapcar '+ p1 (list 0.0 BM 0.0))) ; (list x y 0.0) (command "LINE" p1 (polar p1 (/ pi 2.) bm))

no problem , this site is all about learning. Just meant to say if all your old blocks have a blockname like ...A0M06... you may be able to compress your entire routine to : (defun c:patjeacad ( / $p blk str s bn ip) ;;; ($p "DIN931-A0M06x45E" "*A#M##*") -> "A0M06" (defun $p (s p)(if (and (wcmatch s p)(/= "" s)) (cond (($p (substr s 2) p))(($p (substr s 1 (1- (strlen s))) p))(s)))) (cond ((not (tblsearch "BLOCK" "BL$2----_KADER")) (alert "Computer says no : No border in current drawing")) ((not (setq blk (entsel "\nSelect a bolt : "))) (alert "Computer says no : nothing selected")) ((not (eq (cdr (assoc 0 (entget (car blk)))) "INSERT")) (alert "Computer says no : selected item is not a block")) ((not (setq str (cdr (assoc 2 (entget (car blk)))))) (alert "Computer says no : bad block name")) ((setq s ($p str "*A#M##*")) (setq bn (strcat "DIN125A-" s "-E"))) (t (setq bn nil) (alert "Computer says no : invalid block")) ) (if (and bn (setq ip (getpoint "\nInsertion point : "))) (command "-Insert" bn ip "" "" Pause)) (princ) ) this line : ((setq s ($p str "*A#M##*")) (setq bn (strcat "DIN125A-" s "-E"))) would replace your entire cond function with all the wcmatch's inside it. But cond function with all the wcmatches inside is OK too , keeps it nice and simple and easy to add future blocknames to it. In the end its not about what works for me but what best works for you.

Selecting or zooming to an entity based on its handle identification code To select an entity based on its handle ID On the command line enter _SELECT When prompted to select objects, enter (HANDENT "HandleID") where HandleID is the handle identification value of the entity. The entity will be selected and highlighted, and you can either continue selecting entities or press ENTER to end the command. To zoom to an entity based on its handle ID On the command line enter _ZOOM Select the Object option. When prompted to Select Objects, enter (HANDENT "HandleID") where HandleID is the handle identification value of the entity. Once the object is selected press ENTER to Zoom to this object.

I end up posting these all over the forum, so I might as well post a lot of them in one place for those who are interested. _________________________________________________________ Explanation of the Apostrophe: http://www.cadtutor.net/forum/showpost.php?p=258390&postcount=20 Explanation of Logand/Logior: http://www.cadtutor.net/forum/showpost.php?p=298061&postcount=8 Working with Attributes: http://www.cadtutor.net/forum/showpost.php?p=330778&postcount=2 Explanation of Conditionals (CAB/Lee Mac) http://www.cadtutor.net/forum/showpost.php?p=173196&postcount=10 http://www.cadtutor.net/forum/showpost.php?p=240943&postcount=2 http://www.cadtutor.net/forum/showpost.php?p=273108&postcount=12 Selection Set to List http://www.cadtutor.net/forum/showpost.php?p=248285&postcount=2 Block rename: http://www.cadtutor.net/forum/showpost.php?p=242147&postcount=24 VL Method Differences: http://www.cadtutor.net/forum/showpost.php?p=258403&postcount=9 Starting LISP: http://www.afralisp.net/ http://www.jefferypsanders.com/autolisptut.html http://ronleigh.info/autolisp/index.htm More Advanced LISP Tutorials/Help: http://augiru.augi.com/content/library/au07/data/paper/CP311-4.pdf http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-4.html http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node1.html DCL Tutorials: http://www.jefferypsanders.com/autolisp_DCL.html http://www.afralisp.net/ Visual LISP Editor: http://www.afralisp.net/vl/vlisp.htm http://www.afralisp.net/vl/vl-edit.htm http://midpointcad.com/au/docs/lakose_The_Visual_LISP_Developers_Bible.pdf Error Handlers: http://www.afralisp.net/lispa/lisp6.htm http://www.cadtutor.net/forum/showthread.php?t=33966 http://www.cadtutor.net/forum/showpost.php?p=261049&postcount=3 -4 SelectionSets: http://www.afralisp.net/lisp/filter.htm http://www.theswamp.org/index.php?topic=28672.0 Layer Renaming: http://www.cadtutor.net/forum/showthread.php?t=38810 Attributes in VL: http://www.cadtutor.net/forum/showpost.php?p=259620&postcount=9 PaperSpace/ModelSpace Objects: http://www.cadtutor.net/forum/showpost.php?p=259934&postcount=13 Vla-File-Systime: http://www.cadtutor.net/forum/showthread.php?t=38331 Linking Objects with XData: http://www.cadtutor.net/forum/showpost.php?p=251211&postcount=12 Explanation of a LISP function (Text replacement): http://www.cadtutor.net/forum/showpost.php?p=264546&postcount=15 Explanation of a LISP function (Text Height Change): http://www.cadtutor.net/forum/showpost.php?p=306576&postcount=14 Explanation of a LISP function (Reinsert all blocks @ 0,0,0): http://www.cadtutor.net/forum/showpost.php?p=309366&postcount=15 SSGet Available Options: http://www.theswamp.org/index.php?topic=29972 Localising Variables: http://www.cadtutor.net/forum/showpost.php?p=265649&postcount=4 Express Tools Functions: http://www.afralisp.net/lisp/acet-utils.htm http://www.theswamp.org/index.php?action=dlattach;topic=28777.0;attach=12477 http://www.theswamp.org/index.php?topic=13719.0 http://www.theswamp.org/index.php?topic=19505.0 Entmake: http://www.theswamp.org/index.php?topic=4814.0 Undocumented LISP Functions: http://www.manusoft.com/cgi-bin/NoFrames.pl?referer=http://www.manusoft.com/resources/AcadExposed/Index.stm&header=Header.stm&toc=TOC.stm&main=Main.stm#AutoLISP Auto-Loading LISP (ACADDOC.lsp etc): http://www.theswamp.org/index.php?topic=9211.0 http://www.theswamp.org/index.php?topic=20492.0 http://www.cadtutor.net/faq/questions/53/How+do+I+automatically+load+variables%3F AutoCAD Command Prefixes: http://www.cadforum.cz/cadforum_en/qaID.asp?tip=2425 Deleting DWS Associations: http://www.cadtutor.net/forum/showthread.php?t=43380 Car/Cadr/Caddr Explained: http://ronleigh.info/autolisp/afude09.htm http://www.theswamp.org/index.php?topic=31473.0 Default Options: http://www.cadtutor.net/forum/showthread.php?t=39634 Script Writer: http://www.cadtutor.net/forum/showpost.php?p=295487&postcount=23 Demise of VBA: http://www.cadtutor.net/forum/showthread.php?t=32857 Command Vs Entmake Vs VL: http://rkmcswain.blogspot.com/2007/12/command-vs-entmake-vs-vla-add.html Explanation of Boole Function: http://www.cadtutor.net/forum/showpost.php?p=306339&postcount=9 Varying ways to Change Text Height: http://www.cadtutor.net/forum/showpost.php?p=296877&postcount=4 What are vl*,vlax* etc?: http://www.cadtutor.net/forum/showpost.php?p=318549&postcount=2 Setq Vs. Set: http://www.theswamp.org/index.php?topic=27226.msg328322#msg328322 AutoCAD Animation: http://www.cadtutor.net/forum/showthread.php?t=45146 http://www.cadtutor.net/forum/showthread.php?t=1202 http://www.cadtutor.net/forum/showthread.php?t=883 Safearrays/Variants: http://www.theswamp.org/index.php?topic=31674.0 http://www.theswamp.org/index.php?topic=29248.0 DDAtte2 (with visibility toggles): http://www.cadtutor.net/forum/showpost.php?p=308469&postcount=5 _________________________________________________________ Enjoy! Lee

This does the same: (vl-filename-base (getvar 'dwgname))

A quick freebie stops the dwgname.dxf.dxf (setq dwgname (getvar 'dwgname)) (setq len (strlen dwgname)) (setq dwgname (substr dwgname 1 (- len 4)))

Have dug out a short lisp and altered to suit. This will save the current drawing (whole drawing) as a dxf file in the current drawings directory. It doesn't alter the preferences so a normal save will still be in the set format. (defun c:asdxf ( / c_doc) (setq c_doc (vla-get-activedocument (vlax-get-acad-object))) (vla-saveas c_doc (vlax-get-property c_doc 'fullname) ac2007_dxf) (princ "Drawing saved in 2007_dxf Format") );end_defun

Here is a start, I have now jumped to points, what I will do is provide a code sample but will provide a Word.doc with the sub entities highlighted via VLAX-DUMP so you can see down the tree and add any "Components" settings that you may want to customise, I need to do this as point styles with say 8 components and around 6+ items = 48+ variables. Maybe even code in a tree pasting into Autocad DWG. One thing I have come across is using blocks in label styles a problem with rescaling meant changing 8 components. See below (defun getstyleinfo (count stname / stylname lp lay layname) ;Get the Style info and write out (setq x 0) (repeat count (setq style (vlax-get-property lls 'Item x)) ; count is number of styles start at 0 (setq stylname (vla-get-Name style)); is style name ;Get the Label Properties (setq lp (vlax-get-property style 'LabelProperties)) ;Get the Aecc Layer Properties (setq lay (vlax-get-property lp 'Layer)) ;Get the Name of the Layer (setq layname (vlax-get-property lay 'Value)) (write-line (strcat stname "," stylname "," layname) fo) (setq x (+ x 1)) ) ) (load "vercheck") (AH:vercheck) ;Get the Alignment Label Styles (setq als (vlax-get-property *AeccDoc* 'AlignmentLabelStyles)) ; Property values: ; CurveLabelStyles ; DesignSpeedLabelStyles ; GeometryPointLabelStyles ; LineLabelStyles ; MajorStationLabelStyles ; MinorStationLabelStyles ; SpiralLabelStyles ; StationEquationLabelStyles ; StationOffsetLabelStyles ; TangentIntersectionLabelStyles (setq fo (open "c:\\temp\\aligns2.lst" "W")) ;Get the Line Label Styles (setq stname "CurveLabelStyles") (setq lls (vlax-get-property als 'CurveLabelStyles)) (setq count (vla-get-count lls)) ; is how many style names (getstyleinfo count stname) (setq stname "DesignSpeedLabelStyles") (setq lls (vlax-get-property als 'DesignSpeedLabelStyles)) (setq count (vla-get-count lls)) ; is how many style names (getstyleinfo count stname) (setq stname "GeometryPointLabelStyles") (setq lls (vlax-get-property als 'GeometryPointLabelStyles)) (setq count (vla-get-count lls)) ; is how many style names (getstyleinfo count stname) (setq stname "LineLabelStyles") (setq lls (vlax-get-property als 'LineLabelStyles)) (setq count (vla-get-count lls)) ; is how many style names (getstyleinfo count stname) (setq stname "MajorStationLabelStyles") (setq lls (vlax-get-property als 'MajorStationLabelStyles)) (setq count (vla-get-count lls)) ; is how many style names (getstyleinfo count stname) (setq stname "CurveLabelStyles") (setq lls (vlax-get-property als 'CurveLabelStyles)) (setq count (vla-get-count lls)) ; is how many style names (getstyleinfo count stname) (setq stname "MinorStationLabelStyles") (setq lls (vlax-get-property als 'MinorStationLabelStyles)) (setq count (vla-get-count lls)) ; is how many style names (getstyleinfo count stname) (setq stname "SpiralLabelStyles") (setq lls (vlax-get-property als 'SpiralLabelStyles)) (setq count (vla-get-count lls)) ; is how many style names (getstyleinfo count stname) (setq stname "StationEquationLabelStyles") (setq lls (vlax-get-property als 'StationEquationLabelStyles)) (setq count (vla-get-count lls)) ; is how many style names (getstyleinfo count stname) (setq stname "TangentIntersectionLabelStyles") (setq lls (vlax-get-property als 'TangentIntersectionLabelStyles)) (setq count (vla-get-count lls)) ; is how many style names (getstyleinfo count stname) (close fo) (princ) img-218115827-0001.pdf

Try this ... (defun c:Test (/ *error* name ss i obj lft rgt) (vl-load-com) ;;; Tharwat 13. jan. 2013 ;;; (defun *error* (x) (princ "\n *Cancel*")) (if (and (/= (setq name (getstring t "\n Specify Block name :")) "") (/= name nil) (setq ss (ssget "_x" (list '(0 . "INSERT") (cons 410 (getvar 'ctab)) (cons 2 name)))) ) (progn (repeat (setq i (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i))))) (vla-getboundingbox obj 'l 'r) (setq mid (mapcar (function (lambda (q p) (/ (+ q p) 2.))) (setq lft (vlax-safearray->list l)) (setq rgt (vlax-safearray->list r)) ) ) (vla-ZoomCenter (vlax-get-acad-object) (vlax-3d-point mid) (distance lft (list (car rgt) (cadr lft))) ) (if (eq "" (getstring "\n Press enter to continue or space bar:")) (princ) ) ) (alert "*** DONE ***") ) (princ) ) (princ) )

I should probably add this too: http://www.theswamp.org/index.php?topic=24700.0

Jeez, not very many links are there? . . . . . . . :lol: Just having some fun with you Lee. Looks like you've been very busy. I'm sure your efforts will be appreciated by many.

Hi Cary, I might approach it like this: (defun CloseReactor nil (vl-load-com) ;; Lee Mac ~ 14.04.10 ( (lambda ( data / react ) (if (setq react (vl-some (function (lambda ( reactor ) (if (eq data (vlr-data reactor)) reactor) ) ) (cdar (vlr-reactors :vlr-editor-reactor) ) ) ) (if (vlr-added-p react) (vlr-remove react) (vlr-add react) ) (setq react (vlr-editor-reactor data (list (cons :vlr-beginclose 'CloseCallBack) ) ) ) ) (princ (if (vlr-added-p react) "\n** Reactor Activated **" "\n** Reactor Deactivated **" ) ) react ) "Close-Reactor" ) (princ) ) (defun CloseCallBack (reactor arguments) (vla-put-ActiveSpace (setq doc (vla-get-ActiveDocument (setq acad (vlax-get-acad-object)) ) ) acModelSpace ) (vla-ZoomExtents acad) (vla-put-ActiveLayer doc (vla-item (vla-get-layers doc) "0" ) ) (vla-put-ActiveUCS doc (vla-add (vla-get-usercoordinatesystems doc) (vlax-3D-point '(0. 0. 0.)) (vlax-3D-point '(1. 0. 0.)) (vlax-3D-point '(0. 1. 0.)) "TempWord_UCS" ) ) (if (not (eq "" (vla-get-FullName doc))) (vla-saveas doc (vla-get-FullName doc)) ) (princ) ) Here, the reactor function is a toggle, and can be toggled on and off whilst the drawing is open. The reactor will only save the drawing if the drawing has been saved previously. Its untested, but hopefully should work for you. Lee