Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 08/07/2024 in all areas

  1. Thank you everyone! @mhupp I really like the use of grread, @pkenewell 's code worked well too. These will get me where I need. @BIGAL As always thank you. I am trying to avoid using DCL for this one, I'm getting lazy and just want to hit a key a few hundred time a day....lol Thanks Again.
    2 points
  2. So its pretty simple using grread to run sub commands allowing you to switch between the four different types. kinda follows the same principles of pkenewell's code. except its four smaller lisps called from one main lisp. if you wanted to use other buttons you would have to look them up. I think those are for the numpad keys. (defun c:CDS8EA () (entmake '((0 . "LAYER") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "FINAL MEAS") (70 . 0) (62 . 1) (290 . 0))) ;change 62 to the coler you want (setvar 'clayer "FINAL MEAS") (command "-dimstyle" "R" "8 ALN END ARROW") (while (setq pt (getpoint)) (command "_.LINEARDIMENSION" pt) (while (= (getvar "cmdactive") 1) (command pause) ) ) ) (defun C:MyDims (/ *error* P thisdrawing) (defun *error* () (vl-cmdf nil nil nil) ;clear (if (not (member *error* '("Console break" "Function cancelled" "quit / exit abort"))) (princ (strcat "\nError: " errmsg)) ) (setvar 'cmdecho 1) ) (setvar 'cmdecho 0) (setq P T) (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))) (prompt "\nUse Enter to Exit") (while P (while (/= (car (setq key (grread))) 2)) (setq key (cadr key)) (cond ((= key 49) ;#1 key (C:CDS8EA) ) ((= key 50) ;#2 key ) ((= key 51) ;#3 key ) ((= key 52) ;#4 key ) ((= key 53) ;#5 key ) ((= key 54) ;#6 key ) ((= key 55) ;#7 key ) ((= key 56) ;#8 key ) ((= key 57) ;#9 key ) ((= key 13) ;#Enter key (setq P nil) ) ) ) (setvar 'cmdecho 1) (princ) )
    2 points
  3. Do you mean chord length or versine? Chord is AB, versine is CD I was intrigued by this requested - and wanted to test ChatGPTs LISP and math prowess (not sure if allowed - and apologies if this is an insult to the resident LISP gurus!). Results might be useful, but I was impressed it was able to get this far. It took 9 attempts to arrive at this code 2 routines below: DABV1 - divides an ARC into lengths according to specified versine, with a 'remainder' arc DBAV2 - creates equal arc lengths up to maximum of specified versine (defun c:DABV1 ( / arcEntity arcData center radius startAngle endAngle versine chordLength angleIncrement totalAngle numSegments newArcs i angle1 angle2) ;; Function to calculate the arc sine (asin) value (defun asin (x) (atan (/ x (sqrt (- 1 (* x x)))))) ;; Function to calculate the chord length for a given versine and radius (defun chord-for-versine (v r) (* 2 (sqrt (- (* r r) (* (- r v) (- r v)))))) ;; Function to calculate the angle increment for a given chord length and radius (defun angle-for-chord-length (c r) (* 2 (asin (/ (/ c 2) r)))) ;; Get the arc entity from the user (setq arcEntity (entsel "\nSelect an arc: ")) (if (and arcEntity (setq arcEntity (car arcEntity))) (progn (setq arcData (entget arcEntity)) ;; Check if the selected entity is an arc (if (eq (cdr (assoc 0 arcData)) "ARC") (progn ;; Get the arc properties (setq center (cdr (assoc 10 arcData))) (setq radius (cdr (assoc 40 arcData))) (setq startAngle (cdr (assoc 50 arcData))) (setq endAngle (cdr (assoc 51 arcData))) ;; Prompt the user for the versine length (setq versine (getreal "\nEnter the versine length: ")) ;; Ensure versine and radius are positive and radius is non-zero (if (and versine (> versine 0) radius (> radius 0)) (progn ;; Calculate the chord length for the given versine length (setq chordLength (chord-for-versine versine radius)) ;; Calculate the angle increment for the given chord length (setq angleIncrement (angle-for-chord-length chordLength radius)) ;; Calculate the total angle of the arc (setq totalAngle (- endAngle startAngle)) ;; Calculate the number of segments based on the total angle and the angle increment (setq numSegments (fix (/ totalAngle angleIncrement))) ;; Create new arcs (setq newArcs nil) (setq angle1 startAngle) (repeat numSegments (setq angle2 (+ angle1 angleIncrement)) (setq newArcs (cons (entmakex (list (cons 0 "ARC") (cons 10 center) (cons 40 radius) (cons 50 angle1) (cons 51 angle2))) newArcs)) (setq angle1 angle2) ) ;; If there's a remaining segment, add it (if (< angle1 endAngle) (setq newArcs (cons (entmakex (list (cons 0 "ARC") (cons 10 center) (cons 40 radius) (cons 50 angle1) (cons 51 endAngle))) newArcs)) ) ;; Display the new arcs (foreach arc newArcs (entdraw arc)) ) (princ "\nInvalid versine length or radius.") ) ) (princ "\nSelected entity is not an arc.") ) ) (princ "\nNo arc selected.") ) (princ) ) (defun ceiling (x) (if (= x (fix x)) (fix x) (+ (fix x) 1))) (defun c:DABV2 ( / arcEntity arcData center radius startAngle endAngle versine chordLength maxAngleIncrement totalAngle numSegments actualAngleIncrement newArcs i angle1 angle2) ;; Function to calculate the arc sine (asin) value (defun asin (x) (atan (/ x (sqrt (- 1 (* x x)))))) ;; Function to calculate the chord length for a given versine and radius (defun chord-for-versine (v r) (* 2 (sqrt (- (* r r) (* (- r v) (- r v)))))) ;; Function to calculate the angle increment for a given chord length and radius (defun angle-for-chord-length (c r) (* 2 (asin (/ (/ c 2) r)))) ;; Get the arc entity from the user (setq arcEntity (entsel "\nSelect an arc: ")) (if (and arcEntity (setq arcEntity (car arcEntity))) (progn (setq arcData (entget arcEntity)) ;; Check if the selected entity is an arc (if (eq (cdr (assoc 0 arcData)) "ARC") (progn ;; Get the arc properties (setq center (cdr (assoc 10 arcData))) (setq radius (cdr (assoc 40 arcData))) (setq startAngle (cdr (assoc 50 arcData))) (setq endAngle (cdr (assoc 51 arcData))) ;; Prompt the user for the versine length (setq versine (getreal "\nEnter the versine length: ")) ;; Ensure versine and radius are positive and radius is non-zero (if (and versine (> versine 0) radius (> radius 0)) (progn ;; Calculate the chord length for the given versine length (setq chordLength (chord-for-versine versine radius)) ;; Calculate the maximum angle increment for the given chord length (setq maxAngleIncrement (angle-for-chord-length chordLength radius)) ;; Calculate the total angle of the arc (setq totalAngle (- endAngle startAngle)) ;; Calculate the number of segments required, rounding up to ensure the versine is not exceeded (setq numSegments (ceiling (/ totalAngle maxAngleIncrement))) ;; Calculate the actual angle increment to evenly divide the arc into `numSegments` (setq actualAngleIncrement (/ totalAngle numSegments)) ;; Create new arcs (setq newArcs nil) (setq angle1 startAngle) (repeat numSegments (setq angle2 (+ angle1 actualAngleIncrement)) (setq newArcs (cons (entmakex (list (cons 0 "ARC") (cons 10 center) (cons 40 radius) (cons 50 angle1) (cons 51 angle2))) newArcs)) (setq angle1 angle2) ) ;; Display the new arcs (foreach arc newArcs (entdraw arc)) ) (princ "\nInvalid versine length or radius.") ) ) (princ "\nSelected entity is not an arc.") ) ) (princ "\nNo arc selected.") ) (princ) )
    1 point
  4. Maybe something like this? Change the Dimstyle names in the (cond) statement to match your dimension styles. You can also change the wording between the "[...]" in the getpoint prompt as long as you keep the "1-, 2-." etc. on the front of each option. You could also change the default option to "Exit" if you change the option in the "<...>" of the prompt and the code line (if (not p1)(setq p1 "1")) to "Exit" as well. ;;Written by PJK 8/6/2024 (defun C:LDIM (/ p1) (initget "1 2 3 4 Exit") (while (and (/= (type (setq p1 (getpoint "\nSelect first point for Linear Dimension or [1-Style1/2-Style2/3-Style3/4-Style4/Exit] <1-Style1>: "))) 'LIST) (/= p1 "Exit") ) (if (not p1)(setq p1 "1")) (cond ((= p1 "1")(command "._-dimstyle" "_r" "MyDimStyle1"));; Change Dim Style Names to Your preferences. ((= p1 "2")(command "._-dimstyle" "_r" "MyDimStyle2")) ((= p1 "3")(command "._-dimstyle" "_r" "MyDimStyle3")) ((= p1 "4")(command "._-dimstyle" "_r" "MyDimStyle4")) ) (initget "1 2 3 4 Exit") ) (if (= (type p1) 'LIST) (progn (command "._dimlinear" p1) (while (= (logand (getvar "cmdactive") 1) 1) (command pause) ) ) ) (princ) )
    1 point
×
×
  • Create New...