Leaderboard

Nice little functions for radian conversion. (defun RtD (r) (* 180.0 (/ r pi))) ;Radian to Degree (defun DtR (d) (* pi (/ d 180.0))) ;Degree to Radian (setq hatchangle (DtR 270))

So how are you with making up a LISP? This line will select everything in the drawing, but you can add a filter to that to get more what you want (setq (ssget "x")) This line will select all hatches (setq ss (ssget "x" '((0 . "hatch")))) This line will select all the hatches of type ANSI31 (setq ss (ssget "x" '((0 . "hatch")(2 . "ANSI31")))) (see how I am building up ssget filter to get what I am looking for) and even better this line will select all the ANSI31 hatches at an angle of 0 (setq ss (ssget "x" '((0 . "hatch")(2 . "ANSI31")(52 . 0.0))) ) If you want you can put variables instead of ANSI31 and 0.0 which can be defined earlier Now a problem will happen if you don't have any hatches of that style at that angle, you might get round that with: (setq hatchtype "ANSI31") (setq hatchangle 0.0) ;;Note angle is in radians (if (setq ss (ssget "x" '((0 . "hatch")(2 . hatchtype)(52 . hatchangle))) ) (progn ;;... do your stuff here with the selection set 'ss' ); end progn );end if

Noticed a initget this may be useful for yes no. (SETQ reply (ACET-UI-MESSAGE "Draw a line to close any gaps? " "Yes No Choice" (+ Acet:YESNOCANCEL Acet:ICONWARNING) ) ) ;; Yes = 6 ;; No = 7 ;; Cancel = 2 (IF (= reply 6) (PROGN (ALERT "Yep") ;; ;; More Yes Mojo ) ;; else (PROGN (ALERT "Nope") ;; ;; More no mojo ) )

(setq ssLines (ssadd));needs this one initialized (while (and ;and, not = ;getpoint, not getpoimt (setq sp (getpoint "\nDraw Line to close up spaces or divide them - Start Point: ")) (setq ep (getpoint "\nNext Point (enter to skip): " sp));add sp as basepoint ) (Command "._Line" sp ep "") (setq ssLines (ssadd (entlast) ssLines)) ) Sorry my code need some debugged and fixed as above. My eyes must be very bad to type getpoimt instead of getpoint

Thank you very much, sorry for the unnecessary new post

Here is a close start for you. You may want to set a dimension style eg (command "-dimstyle" "R" "standard") tested on your dwg needed dimscale to be reset. ; simple draw a box and dimension it ; By Alan H March 2019 ' info@alanh.com.au (defun ah:box ( / pt1 pt2 pt3 ahl ahh ahoff ) (setq oldsnap (getvar 'osmode)) (setq oldang (getvar 'angdir)) (setq pt1 (getpoint "\nPick lower left")) (setvar 'osmode 0) (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (setq ans (AH:getvalsm (list "Simple rectang" "Enter length" 8 7 "1" "Enter height " 8 7 "2"))) (setq ahL (atof (nth 0 ans))) (setq ahH (atof (nth 1 ans))) (setq pt2 (polar pt1 0.0 ahl)) (setq pt3 (polar pt2 (/ pi 2.0) ahH)) (command "rectang" pt1 pt3) (setq ahoff (* 2.0 (* (getvar 'dimasz)(getvar 'dimscale)))) ; change offset as required (setq pt4 (polar pt2 (* pi 1.5) ahoff)) (command "dim" "hor" pt1 pt2 pt4 "" "exit") (setq pt4 (polar pt3 0.0 ahoff)) (command "dim" "Ver" pt2 pt3 pt4 "" "exit") (setvar 'osmode oldsnap) ) (ah:box) You can see how the box is made so using polar can work out inside box. The multi getvals.lsp needs to be loaded 1st or put in a support path location. Hint for your version. (setq ans (AH:getvalsm (list "Enter Values" "X" 5 4 "100" "X2" 5 4 "50" "X3" 5 4 "50" "Y " 5 4 "100" "Y1 " 5 4 "50" "Y2 " 5 4 "50" "Rad" 5 4 "10" ))) I have added multi toggles for the circles say 1 2 3 4 tick on for position. yes could hard code a single dcl. Multi toggles.lsp Is the inner rectang required or is that just to show the hole positions ? Multi GETVALS.lsp

This require say 5 steps to get the answer, for me I would go back steps making life easier, and have layers 63PE, 90PE, and so on removes 1 step of finding a label. If you had a simple lisp draw pline on correct layer and label at same time would make sense. I have something similar to do with pipes and it just means type 90PE at command line. Taking it the next step would be add reducer or end cap, as you draw it, would make a table or csv at the same time want length also ? Ps have table to excel. Now getting into donation could write direct to excel as you draw. So have a think about an overall improvement rather than after the event. This image is from a free library dcl toggle choice. Took like 1 minute to make the calling code.

Its a pity Autodesk killed Lisp Enabler for LT. As you say Steven a good VBA programmer may be able to use excel as front end creating scripts or copy paste a column.

ssLines is just for me to remember what that selection set was for and not to overlap any variables. Plus ss is a bit vague for my liking. Error handling is not my strong suit either as you can probably see from the code below. Here's the latest one. Seems to be exactly what I was after. There's a total of 3 commands to choose from. See the code for the notes on what they badly do (vl-load-com) ; Quick loaders for the scripts below. (defun c:--LDArea_Get_Picked_New_Text ( / ) (progn (LOAD "3dwannab_Area_Get") (C:Area_Get_Picked_New_Text))) (defun c:--LDArea_Get_Picked_Mod_Text ( / ) (progn (LOAD "3dwannab_Area_Get") (C:Area_Get_Picked_Mod_Text))) (defun c:--LDArea_Get_Area_Mod_Text ( / ) (progn (LOAD "3dwannab_Area_Get") (C:Area_Get_Area_Mod_Text))) ; ; Area_Get_Area_Mod_Text by 3dwannab ; ; First written on the 2022.01.24 ; It's a WIP! ; ; WHAT IS DOES: ; 1. Will prompt the user to use the area command. ; 2. Then once enter or space bar is pressed, you can then select the TEXT or ; MTEXT to update it with the new area in m². ; ; TO DO: ; Nothing at the time of writing :) ; ; NOTES: ; - The units used must be decimal. ; - Rounds off the area to 2 decimal places. ; - The text must have the contents of either: 4.00m2 or 4.00m² to replace it ; with. ; - And this can also have other text in there but this program will only ; replace either of the 2 types of string above as the match is done using a ; regular expression. ; (defun c:Area_Get_Area_Mod_Text ( / *error* areacmdstr areainmmval ent i mtextcontents pthatch regexp_oldstr result ssText str var_cmdecho var_nomutt var_osmode ) (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) (setvar 'nomutt var_nomutt) (setvar 'cmdecho var_cmdecho) (setvar 'osmode var_osmode) ) (setq var_cmdecho (getvar "cmdecho")) (setq var_nomutt (getvar "nomutt")) (setq var_osmode (getvar "osmode")) (setvar 'hpislanddetection 2) ; 0 Normal. Hatches islands within islands. 1 Outer. Hatches only areas outside of islands. 2 Ignore. Hatches everything within the boundaries. (setvar 'cmdecho 0) (setvar 'osmode 3) ; Sets osmode for Endpoint and midpoint. keeping it simple. ; Enter the area command (command-s "area" pause "" "") ; Use the area command to get the last value (command "._area" "_O" "_L") (setq areainmmval (rtos (/ (getvar "area") 1e6) 2 2)) ; How to get m² from mm² in area in AutoCAD. https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/mm2-to-m2-soma-areas-m2-lsp-and-mm-to-m-soma-perimetros-lsp/m-p/5963137/highlight/true#M337718 (setq areacmdstr (strcat "\n\nArea in m\U+00B2 is: " areainmmval)) (setq mtextcontents (strcat areainmmval "m\U+00B2")) (terpri)(princ (strcat areacmdstr))(terpri) ; Select the TEXT and/or MTEXT that needs to get updated (Can be multiple selection) (terpri)(prompt "Select the TEXT and/or MTEXT you want to update:")(terpri) (setvar 'nomutt 1) ; Setting the numutt variable to 1 allows the prompt to show up. See: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/ssget-with-custom-prompt/m-p/1735374#M219362 (setq ssText (ssget '((0 . "*TEXT")))) (setvar 'nomutt 0) ; Modify the selected TEXT and/or MTEXT with the area in meters squared (if ssText (progn (repeat (setq i (sslength ssText)) (setq ent (entget (ssname ssText (setq i (1- i)))) str (cdr (assoc 1 ent)) ) (if (wcmatch str "*") (progn (setq regexp_oldstr "\\d+\\.?\\d*m[²|2]") (setq result (SS_RegExp str regexp_oldstr mtextcontents )) (setq str (vl-string-translate "*" " " result) ) (setq ent (subst (cons 1 str) (assoc 1 ent) ent)) (entmod ent) ) ) ) ) ; End progn ) ; End if ssText (command "area" "_O" "_L") (setq areainmmval (rtos (/ (getvar "area") 1e6) 2 2)) ; How to get m² from mm² in area in AutoCAD. https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/mm2-to-m2-soma-areas-m2-lsp-and-mm-to-m-soma-perimetros-lsp/m-p/5963137/highlight/true#M337718 (setq areacmdstr (strcat "\n\nArea in m\U+00B2 is: " areainmmval)) (*error* nil) (princ) ) ; CREATED BY: alan thompson 11.28.07 ; MODIFIED BY: alan thompson 12.19.07 (MTEXT instead of TEXT, lot numbering works better, etc.) ; MODIFIED BY: 3dwannab 20.01.22 ; ; WHAT IS DOES: ; 1. Will prompt the user to use the area command. ; 2. Then once enter or space bar is pressed, you can then select the TEXT or ; MTEXT to update it with the new area in m². ; ; TO DO: ; Update to draw temp lines, the same as Area_Get_Picked_Mod_Text. ; ; NOTES: ; Just modified slightly to work with decimals as units. ; Prompts the user to pick a distance for the HATCH gap tolerance. This is useful for when there's doorways that need closing. ; Asks user for the height of the MTEXT. ; Outputs '95.78m²' to the MTEXT object and 'Area in m²: 95.78' to the command line. (defun c:Area_Get_Picked_New_Text ( / *error* areacmdstr areainmmval gaptolerance gaptoleranceDefault mtextcontents pthatch var_cmdecho var_hpgaptol var_hpislanddetection ; var_nomutt var_osmode ) (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) (setvar 'cmdecho var_cmdecho) ; (setvar 'nomutt var_nomutt) (setvar 'osmode var_osmode) (setvar 'hpgaptol var_hpgaptol) (setvar 'hpislanddetection var_hpislanddetection) ) (setq var_hpislanddetection (getvar "hpislanddetection")) (setq var_hpgaptol (getvar "hpgaptol")) (setq var_cmdecho (getvar "cmdecho")) ; (setq var_nomutt (getvar "nomutt")) (setq var_osmode (getvar "osmode")) (setvar 'hpislanddetection 2) ; 0 Normal. Hatches islands within islands. 1 Outer. Hatches only areas outside of islands. 2 Ignore. Hatches everything within the boundaries. (setvar 'cmdecho 0) (setvar 'osmode 0) ; Get saved offset from registry or default to 1 (setq gaptoleranceDefault (getvar "hpgaptol")) ; Prompt for distance, if nil use default (setq gaptolerance (cond ((getdist (strcat "\nPick or enter the gap tolerance for the hatched area :\nCurrent value <" (vl-princ-to-string (getvar "hpgaptol")) ">: "))) (gaptoleranceDefault) ) ) ; Click the internal area for the hatching (graphscr) (setq pthatch (getpoint "\nClick internal point : "))(terpri) (command "-hatch" "_T" "70" "_A" "_G" gaptolerance "" pthatch "" ) (command "area" "_O" "_L") (setq areainmmval (rtos (/ (getvar "area") 1e6) 2 2)) ; How to get m² from mm² in area in AutoCAD. https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/mm2-to-m2-soma-areas-m2-lsp-and-mm-to-m-soma-perimetros-lsp/m-p/5963137/highlight/true#M337718 (setq areacmdstr (strcat "\n\nArea in m\U+00B2 is: " areainmmval)) (command "._erase" "_L" pause) ; This will auto select the last item to get deleted. This is just for double checking it was hatched correctly. ; (command "._erase" "_L" "") ; This will delete the last object created. (setq mtextcontents (strcat areainmmval "m\U+00B2")) (princ (strcat areacmdstr)) (command "._MTEXT" pthatch "_J" "_MC" "_C" "_N" "_H" pause pthatch mtextcontents "") (setvar 'cmdecho var_cmdecho) (setvar 'osmode var_osmode) (*error* nil) (princ) ) ; ; Area_Get_Picked_Mod_Text by 3dwannab ; ; First written on the 2022.01.22 ; It's a WIP! ; ; WHAT IS DOES: ; 1. First create a layerstate to restore that after and hide layers that ; contain things like, fur, dim, kitchen or hatch. ; 2. Then ask to draw temporary lines to close up any large gaps. ; 3. Asks the user for a gap tolerance. If no gaps are leading to the other ; model space then this doesn't need any value. ; 4. Pick an internal point inside the area that you have closed with the ; temporary lines. ; 5. Lastly, you can make a selection on the existing TEXT or MTEXT to update ; the text. ; 6. And lastly, lastly it'll remove the temporary lines you had created. ; ; TO DO: ; Nothing at the time of writing :) ; ; NOTES: ; - The units used must be decimal.; - Rounds off the area to 2 decimal places. ; - The text must have the contents of either: 4.00m2 or 4.00m² to replace it ; with. ; - And this can also have other text in there but this program will only ; replace either of the 2 types of string above as the match is done using a ; regular expression. ; (defun c:Area_Get_Picked_Mod_Text ( / *error* areacmdstr areainmmval ent gaptolerance h i linePt loopForDrawLines msgLineDraw mtextcontents pthatch ssHatches ssLines ssText stateName str var_cmdecho var_hpgaptol var_hpislanddetection var_hpislanddetectionmode var_hpname var_hpquickpreview var_hptransparency var_nomutt var_osmode ) (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) ; Deletes the temporary lines and hatches (if ssLines (command-s "_.Erase" ssLines "")) (if ssHatches (command-s "_.Erase" ssHatches "")) ; Restore the layer states and delete it (layerstate-restore stateName nil nil) (if (layerstate-has stateName) (progn (layerstate-delete stateName nil nil) ; (layerstate-save stateName nil nil) ) ) (princ "\nExiting '3dwannab_Area_Get.lsp' Program\n")(princ) (setvar 'cmdecho var_cmdecho) (setvar 'hpgaptol var_hpgaptol) (setvar 'hpislanddetection var_hpislanddetection) (setvar 'hpislanddetectionmode var_hpislanddetectionmode) (setvar 'hpname var_hpname) (setvar 'hpquickpreview var_hpquickpreview) (setvar 'hptransparency var_hptransparency) (setvar 'nomutt var_nomutt) (setvar 'osmode var_osmode) ) ; Sets the variables (setq var_cmdecho (getvar "cmdecho")) (setq var_hpgaptol (getvar "hpgaptol")) (setq var_hpislanddetection (getvar "hpislanddetection")) (setq var_hpislanddetectionmode (getvar "hpislanddetectionmode")) (setq var_hpname (getvar "hpname")) (setq var_hpquickpreview (getvar "hpquickpreview")) (setq var_hptransparency (getvar "hptransparency")) (setq var_nomutt (getvar "nomutt")) (setq var_osmode (getvar "osmode")) ; Set the ACAD variables that need setting for the program ; Here's a list of variables relating to hatching: https://knowledge.autodesk.com/support/autocad/learn-explore/caas/CloudHelp/cloudhelp/2021/ENU/AutoCAD-Core/files/GUID-B94870E7-49CE-4BB0-A978-382A38E1FED8-htm.html (setvar 'cmdecho 0) (setvar 'hpislanddetection 2) ; 0 Normal. Hatches islands within islands. 1 Outer. Hatches only areas outside of islands. 2 Ignore. Hatches everything within the boundaries. (setvar 'hpislanddetectionmode 1) ; Important that this is set to 1. Controls whether islands within new hatches and fills are detected in this session. 0 Off. 1 On (recommended). Hatches or ignores islands according to HPISLANDDETECTION. (setvar 'hpname "SOLID") ; This must be a string. (setvar 'hpquickpreview 1) ; This is either 0 for off or 1 for on. Test this in the off state. (setvar 'hptransparency "22") ; This must be a string. (setq stateName "3dwannab_Area_Get") (progn ; Save the layer states here before hiding layers below (layerstate-save stateName nil nil) ; Hide any layers (command "-layer" "_OFF" "*fur*" "") (command "-layer" "_OFF" "*dim*" "") (command "-layer" "_OFF" "*kitchen*" "") (command "-layer" "_OFF" "*hatch*" "") (command "-layer" "_OFF" "*door*" "") ; While loop to draw temporary lines using initget ; Based off LeeMacs code here: https://www.cadtutor.net/forum/topic/70799-how-to-continuously-run-a-condition/#comment-568357 (setvar 'osmode 3) ;;set snaps to what you want (setq ssLines (ssadd)) ;;create empty selection set (setq loopForDrawLines "loop") ;;marker to whether to loop again or end the loop (while (= "loop" loopForDrawLines ) ;;Loop if loop marker says 'loop' (setq MyPoint (getpoint "\nDraw gap filling line \[ Press SPACE or ENTER to end ) : ")) (if (= MyPoint nil) (setq loopForDrawLines "StopLoop") ;; if no point is selected (enter or space pressed) (progn ;;else do this loop (Command "._Line" MyPoint pause "") (setq MyPoint nil) ;;might not be needed, but why not have this (setq ssLines (ssadd (entlast) ssLines)) ;;add line to selection set (as item 0, the previous line is line 1, etc) ) ) ) ;end while ; Only turn off osmode after drawing the lines. (setvar 'osmode 0) ; Get hpgaptol variable and set it to the entered amount (setq gaptoleranceDefault (getvar "hpgaptol")) ; Prompt for distance, if nil use default (setq gaptolerance (cond ((getdist (strcat "\nPick or enter the gap tolerance for the hatched area :\nCurrent value <" (vl-princ-to-string (getvar "hpgaptol")) ">: "))) (gaptoleranceDefault) ) ) (setvar "hpgaptol" gaptolerance) ; (princ (strcat "\n" (getvar "hpgaptol") "\n")) ; Click the internal area for the hatching (princ "Pick inside an area you want to calculate : ") (command "_.bhatch") ; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/hatching-by-lisp/m-p/5923832/highlight/true#M336978 (setq ssHatches (ssadd)) ; creates a blank selection set (setq ssHatches (ssadd (entlast) ssHatches)) ; Loop the hatch command until the user exits or returns out it (while (> (getvar 'cmdactive) 0) (progn ; Some defunct testing code ; (if (wcmatch ((getvar 'lastprompt) "Valid hatch boundary not found.")) ; (princ "not ok") ; (princ "ok") ; ) (command pause) (setq ssHatches (ssadd (entlast) ssHatches)) ) ) ; while end ; Use the area command to get the last value (command "._area" "_O" "_L") (setq areainmmval (rtos (/ (getvar "area") 1e6) 2 2)) ; How to get m² from mm² in area in AutoCAD. https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/mm2-to-m2-soma-areas-m2-lsp-and-mm-to-m-soma-perimetros-lsp/m-p/5963137/highlight/true#M337718 (setq areacmdstr (strcat "\n\nArea in m\U+00B2 is: " areainmmval)) (setq mtextcontents (strcat areainmmval "m\U+00B2")) (terpri)(princ (strcat areacmdstr))(terpri) ; Select the TEXT and/or MTEXT that needs to get updated (Can be multiple selection) (terpri)(prompt "Select the TEXT and/or MTEXT you want to update:")(terpri) (setvar 'nomutt 1) ; Setting the numutt variable to 1 allows the prompt to show up. See: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/ssget-with-custom-prompt/m-p/1735374#M219362 ; (setq ssText (ssget '((0 . "MTEXT,TEXT")))) (setq ssText (ssget '((0 . "*TEXT")))) (setvar 'nomutt 0) ; Modify the selected TEXT and/or MTEXT with the area in meters squared (if ssText (progn (repeat (setq i (sslength ssText)) (setq ent (entget (ssname ssText (setq i (1- i)))) str (cdr (assoc 1 ent)) ) (if (wcmatch str "*") (progn (setq regexp_oldstr "\\d+\\.?\\d*m[²|2]") (setq result (SS_RegExp str regexp_oldstr mtextcontents )) (setq str (vl-string-translate "*" " " result) ) (setq ent (subst (cons 1 str) (assoc 1 ent) ent)) (entmod ent) ) ) ) ) ; End progn ) ; End if ssText ) (*error* nil) (princ) ) ;; ----------------------------------------------------------------------- ;; ----------------------=={ Functions START }==-------------------------- (defun SS_RegExp ( strOld findPattern strReplace / reObj result ) (vl-load-com) (setq reObj (vlax-create-object "Vbscript.RegExp")) (vlax-put-property reObj "IgnoreCase" 1) (vlax-put-property reObj "Global" 1) (vlax-put-property reObj "Pattern" findPattern ) (setq result (vlax-invoke-method reObj "Replace" strOld strReplace) ) result ) (princ (strcat "\n3dwannab_Area_Get.lsp edited on " (menucmd "m=$(edtime,0,DD-MO-yyyy)") " by 3dwannab (stephensherry147@yahoo.co.uk) loaded" "\nType \"Area_Get_Picked_New_Text\" or \"Area_Get_Picked_Mod_Text\" to run Program" ) ) (princ)

AutoCAD has a language all of its own, and some replies well may baffle you. Hopefully you have drawn the plans to full scale, i.e.one of your chosen units (metre, millimetre, foot, inch, furlong, etc.) unit is one drawing unit. That makes matters so much more simple. You have to decide the scale of the output A4 drawings which makes it easier to size the dimensions. Whatever people say, it IS allowable to plot from Model Space instead of Paper Space (Layouts). I have been doing it for 30 years and have not suffered any bad effects. You may be in the UK, so at this time (8.00 p.m.) most replies may be from other parts of the world. So, as time would seem to be a factor, you should post the drawing that you have done, and then some kind soul can either edit your drawing or post some suitable A4 PDFs, or provide some incomprehensible advice. I presume that your Block Plan and Location Plan have been provided by others.

Hard to say for sure without the files. What is an AutoCAD Lite Table? Could be graphics card or driver related. What are your computer specifications? What OS are you using? What version of Excel?

@Emmanuel Delay your code places the dimension on the opposite side of the line when ar is to the left of al and the aligned dimension goes from left to right. Here's a before and after shot. I avoid using angles although sometimes it is easier. Here's a modified version of your code using vectors. (defun deg2rad (ang / ) (/ (* PI ang) 180.0) ) (defun rad2deg ( ang / ) (/ (* 180.0 ang) PI) ) ;; midpoint of 2 given points (defun mid ( pt1 pt2 / ) (mapcar '(lambda (x y) (+ (* 0.5 x) (* 0.5 y))) pt1 pt2 ) ) ;;; Calculate unit vector of vector a (defun uvec (a / d) (setq d (distance '(0 0 0) a) a (mapcar '/ a (list d d d)) ) ) ; Compute the dot product of 2 vectors a and b (defun dot ( a b / dd) (setq dd (mapcar '* a b)) (setq dd (+ (nth 0 dd) (nth 1 dd) (nth 2 dd))) ) ;end of dot (defun c:test2 ( / sel ent txp al ar mp uALR s txpp uvt tp ) (princ "\nDistance DIM: ") (setq dist (getreal)) (while (setq sel (entsel "\nSelect DIM: ")) (setq ent (car sel )) (setq txp (cdr (assoc 10 (entget ent)))) (setq al (cdr (assoc 13 (entget ent)))) (setq ar (cdr (assoc 14 (entget ent)))) ;;; (setq ang1 (angle al ar)) ;;; (setq mp (mid al ar)) ;;; ;;; (setq ang2 (angle mp txp)) ;;; ;;; (if (< ang1 ang2) ;;; (setq tp (polar mp (+ ang1 (deg2rad 90.0)) dist)) ;;; (setq tp (polar mp (- ang1 (deg2rad 90.0)) dist)) ;;; ) (setq mp (mapcar '/ (mapcar '+ al ar) '(2. 2. 2.) ) ) ; uALR = unit vector from al to ar (setq uALR (uvec (mapcar '- ar al))) (setq s (dot uALR (mapcar '- txp al))) ; txpp = projection of txp onto the line (setq txpp (mapcar '+ al (mapcar '* uALR (list s s s))) ) (setq uvt (uvec (mapcar '- txp txpp))) (setq tp (mapcar '+ mp (mapcar '* uvt (list dist dist dist)))) (entmod (subst (cons 10 tp) (assoc 10 (entget ent)) (entget ent)) ) (entmod (subst (cons 11 tp) (assoc 11 (entget ent)) (entget ent)) ) ) (princ) )