Leaderboard

(defun c:11 (/ p0 ang dist) (vl-load-com) (setq p0 (getpoint "Pick the first point >") ang (angtof (rtos (getreal "Enter angle >")) 0) ) (setvar "SNAPANG" ang) (setq dist (distance p0 (getpoint p0 "Pick a second point >"))) (entmakex (list (cons 0 "LINE") (cons 10 p0) (cons 11 (polar p0 ang dist)))) (setvar "SNAPANG" 0) )

My take on your problem. Just ask if this is what you want. Pick a point then The No code way is to use SNAPANG 30 & press F8, Ortho on, this will set your angle as you draw a line. Just remember must do Snapang 0 to go to normal angle.

I have a survey with the topographic elevations (not annotative) called out with leaders. I would like to scale all those leaders by "x" all at the same time and all from the tip of the leaders (individually). Is there a Lisp routine that I can use to do this? I am currently selecting each individual one and applying the scale command. This is very time consuming and tedious, any help will be greatly appreciated. 23-1906ATOPOSTRIP.dwg

@Steven PThanks for the comments, now everything is clear...

Small change I'd make, (defun c:11 (/ p0 ang dist) (defun 11error ( errormsg / ) (setvar "SNAPANG" old_snapang) ; reset variables (setq *error* temperr) ; reset *error* (prompt "\nFunction Canelled.") ) (vl-load-com) (setq p0 (getpoint "Pick the first point >") ang (angtof (rtos (getreal "Enter angle >")) 0) ) (setq Old_snapang (getvar "SNAPANG") ) ; to record what it was, might not be 0 (setq temperr *error*) ;store *error* ; can wait till here to set error function, after recording old variables (setq *error* 11error) (setvar "SNAPANG" ang) (setq dist (distance p0 (getpoint p0 "Pick a second point >"))) (setvar "SNAPANG" Old_Snapang) ; moved this here, seto to old value (no assumption what it was) (entmakex (list (cons 0 "LINE") (cons 10 p0) (cons 11 (polar p0 ang dist)))) (setq *error* temperr) ; reset error )

Think OP wants to set the angle by text and set the distance on the screen. LISP maybe: get angle, set snapang to this, draw line, reset snapang to previous. Add error processing to return snapang to original in case of escape for example.

My version. Don't scold too much. (defun c:11 (/ p0 ang dist) (vl-load-com) (setvar "DYNMODE" 1) (setvar "ORTHOMODE" 0) (setvar "SNAPMODE" 0) (setvar "OSMODE" 0) (setq p0 (getpoint "SPick the first point >") ang (angtof (rtos (getreal "Enter angle >")) 0) dist (distance p0 (getpoint p0 "Pick a second point >")) ) (entmakex (list (cons 0 "LINE") (cons 10 p0) (cons 11 (polar p0 ang dist)))) )

; POINTGRID - 2023.08.17 exceed ; https://www.cadtutor.net/forum/topic/76068-point-grid-by-selecting-polyline/?do=findComment&comment=622077 ; Make point grid in closed polyline or circle. ; command : POINTGRID ; 1. Select objects to use as boundary. ; 2. Enter the x, y spacing gap value between each point. ; 3. If you want to give a margin to the inside of the boundary object, enter an offset value. ; (Enter the space bar if not necessary.) ; This code modifies PDMODE and PDSIZE variable for visibility. you can modify it to you want. (defun c:POINTGRID ( / ss x_gap y_gap base_offset ssl index ent obj minpt maxpt x_dist y_dist x_count y_count x_val y_val x_return pt_val judge point_output ) (vl-load-com) (princ "\n pick boundary polyline : ") (setq ss (ssget)) (setq x_gap (abs (getreal "\n input x gap : "))) (setq y_gap (abs (getreal "\n input y gap : "))) (setvar 'pdmode 33) (setvar 'pdsize (/ (min x_gap y_gap) 5)) (setq base_offset (getreal "\n input inside offset (if required) : ")) (if (= base_offset nil) (setq base_offset 0) (setq base_offset (abs base_offset))) (setq ssl (sslength ss)) (setq ss2 (ssadd)) (setq index 0) (repeat ssl (setq ent (ssname ss index)) (if (> base_offset 0) (progn (setq obj (EX:InsideOffsetOnce (vlax-ename->vla-object ent) base_offset)) ) (setq obj (vlax-ename->vla-object ent)) ) (vla-GetBoundingBox obj 'minpt 'maxpt) (setq minpt (vlax-safearray->list minpt)) (setq maxpt (vlax-safearray->list maxpt)) (setq x_dist (- (- (car maxpt) (car minpt)) base_offset)) (setq y_dist (- (- (cadr maxpt) (cadr minpt)) base_offset)) (setq x_count (fix (/ x_dist x_gap))) (setq y_count (fix (/ y_dist y_gap))) (setq x_val (+ (car minpt) base_offset)) (setq x_return x_val) (setq y_val (+ (cadr minpt) base_offset)) (repeat (+ y_count 1) (repeat (+ x_count 1) (setq pt_val (list x_val y_val)) (if (setq judge (@cv_inside pt_val (vlax-vla-object->ename obj) 1)) (progn ;(princ "\n ") ;(princ judge) ;(princ pt_val) ;(princ " : it's inside") ;(setq circletest (entmakex (list '(0 . "CIRCLE") (cons 10 pt_val) (cons 62 8) (cons 40 (/ (min x_gap y_gap) 5))))) (setq point_output (entmakex (list (cons 0 "POINT") (cons 100 "AcDbEntity") (cons 67 0) (cons 100 "AcDbPoint") (cons 10 pt_val ) (cons 50 0)))) (setq ss2 (ssadd point_output ss2)) ) (progn ;(princ "\n ") ;(princ judge) ;(princ pt_val) ;(princ " : it's not inside") ) ) (setq x_val (+ x_val x_gap)) ) (setq x_val x_return) (setq y_val (+ y_val y_gap)) ) (if (> base_offset 0) (vla-delete obj) ) (setq index (+ index 1)) ) (princ "\n complete") (redraw) (sssetfirst nil ss2) (princ) ) ; EX:InsideOffsetOnce - 2023.08.01 exceed ; Inside Offsets the "obj" object entered as an argument inward by "offdis" numeric value. (defun EX:InsideOffsetOnce ( obj offdis / offsetobj subloop1 subloop2 subloop1type subloop2type subloop1length subloop2length looplength ) (if (vlax-method-applicable-p obj 'offset) (progn (setq subloop1 (car (vlax-safearray->list (vlax-variant-value (vlax-invoke-method obj 'Offset (* offdis 1)))))) (setq subloop2 (car (vlax-safearray->list (vlax-variant-value (vlax-invoke-method obj 'Offset (* offdis -1)))))) (setq subloop1type (vlax-get-property subloop1 'ObjectName)) (setq subloop2type (vlax-get-property subloop2 'ObjectName)) (cond ((= subloop1type "AcDbPolyline") (setq subloop1length (vlax-get-property subloop1 'length))) ((= subloop1type "AcDbCircle") (setq subloop1length (vlax-get-property subloop1 'Circumference))) ((= subloop1type "AcDbArc") (setq subloop1length (vlax-get-property subloop1 'Radius))) ) (cond ((= subloop2type "AcDbPolyline") (setq subloop2length (vlax-get-property subloop2 'length))) ((= subloop2type "AcDbCircle") (setq subloop2length (vlax-get-property subloop2 'Circumference))) ((= subloop2type "AcDbArc") (setq subloop2length (vlax-get-property subloop2 'Radius))) ) (cond ((> subloop1length subloop2length) (vla-delete subloop1) (setq offsetobj subloop2)) ((< subloop1length subloop2length) (vla-delete subloop2) (setq offsetobj subloop1)) ((= subloop1length subloop2length) (vla-delete subloop2) (setq offsetobj subloop1)) ) offsetobj ) (progn (princ "\n This Object Cannot be Offset") ) ) ) ; Joe Burke - https://www.theswamp.org/index.php?topic=7785.msg98782#msg98782 (defun @cv_inside (PIQ Object Draw / IsPolyline Closest Start End Param P ClosestParam NextParam a1 a2 Defl @2D @Insect @Bulge @Deflect @Closest Color) ;; "LOOK, MA'... NO RAYS!" ;; @Inside.lsp v1.0 (09-15-03) John F. Uhden, Cadlantic. ;; v2.0 Revised (09-17-03) - See notes below. ;; v3.0 Revised (09-20-03) - See notes below. ;; v4.0 Revised (09-20-04) but still missing something ;; v5.0 Revised (04-04-04) - See notes below. ;; Function to determine whether a point is inside the boundary ;; of a closed curve. ;; It employs the theorem that the sum of the deflections of a ;; point inside the curve should equal 360°, and if outside 0° ;; (both absolute values). ;; ;; Arguments: ;; PIQ - Point to test (2D or 3D point as a list in UCS) ;; Object - Curve to test (Ename or VLA-Object) ;; Draw - Option to draw vectors to sample points, nil or non-nil ;; ;; Returns: ;; T (if the PIQ is inside the curve) ;; nil (if either the arguments are invalid, ;; or the PIQ is on or outside the curve) ;; ;; NOTES: ;; Requires one or another version of the @delta function, ;; such as included here. ;; It will not work well with self-intersecting (overlapping) ;; bulged polyline segments. ;; Curves can be CIRCLEs, ELLIPSEs, LWPOLYLINEs, POLYLINES, ;; SPLINEs, and maybe even more. ;; Since all the calulations are based on angles relative to the ;; current UCS, there shouldn't be any limitation caused by differences ;; in elevation, but it is not suited for abnormal extrusion directions. ;; (09-17-03) Found that cusps brought back inside the figure ;; yield a total deflection of (* pi 2), so changed evaluation ;; to see if deflection was greater than 4, which is ;; equivalent to a fuzz factor of 2.28 from (* pi 2). ;; (09-20-03) Found that bulged polyline segments needed special ;; attention to determine the closest point to any segment because ;; it might not be the closest point to the object, but must be ;; evaluated to sample sufficient points. ;; (04-04-04) Renamed to original @cv_Inside.lsp (c. 2002) ;; Remembered there was an issue with splines, so included is a ;; Closest evaluation, and a small sample increment, Though I still ;; don't trust the results when the PIQ is near a sharp curve. If splines ;; important then make the sample rate tighter at the expense of speed. ;; For polylines, the sample increment just 1.0 as there is a special ;; subfunction to pick up the midpoint and closest point of bulged segments. ;; For objects such as circles and ellipses the sample increment should be ;; a multiple of pi to achieve a total deflection that is a multiple of pi ;; with in a small fuzz factor. ;; Yes, circles and ellipses can be evaluated more easily by a simple ;; comparison of distances to their center, but this function is ;; intended to treat them as just another curve and to demonstrate ;; the method of using curve parameters and deflections. (vl-load-com) ;; Subunction to determine the deflection angle in radians beween two given angles (or (= (type @delta) 'SUBR) (defun @delta (a1 a2) (cond ((> a1 (+ a2 pi)) (+ a2 pi pi (- a1)) ) ((> a2 (+ a1 pi)) (- a2 a1 pi pi) ) (1 (- a2 a1)) ) ) ) ;; Subfunction to convert a 3D point into 2D for the purpose ;; of ignoring the Z value. ;; Added (09-20-03) (defun @2D (p)(list (car p)(cadr p))) ;;-------------------------------------------------------- ;; Subfunction to determine if an angle is with the sector ;; defined by two other angles. (defun @Insect (Ang Ba Ea) (if (> Ba Ea) (cond ((>= Ang Ba)) ((<= Ang Ea)) (1 nil) ) (< Ba Ang Ea) ) ) ;; Subfunction to find the closest point to an object from a given point, ;; adjusted for elevation differences. Input and output are in UCS (defun @Closest (P / P1 P2) (setq P (trans P 1 0) P2 P ) (while (not (equal P1 P2 1e-10)) (setq P1 P2 P2 (vlax-curve-GetClosestPointTo Object P) P (list (car P)(cadr P)(last P2)) ) ) (trans P2 0 1) ) ;; Subfunction to emulate the GetBulge method, which can be used only ;; for simple polylines, not for fit-curved or splined. ;; Its dual purpose here is to find a point on a bulged segment closest to ;; the PIQ if it is within the bulge's sector and/or the midpoint of ;; the bulged segment, and to compute deflections to same in ascending ;; parameter order. (defun @Bulge (Param / V1 V2 P1 P2 Center Ba Ea Ma MidParam Delta Radius Swap Ang P) (and ;; once again the Koster approach (< Param End) (setq Param (fix Param)) (setq MidParam (+ Param 0.5)) (setq V1 (vlax-curve-getpointatparam Object Param)) (setq V2 (vlax-curve-getpointatparam Object MidParam)) (setq Ba (apply 'atan (reverse (@2d (vlax-curve-getSecondDeriv Object Param))))) (setq Ea (apply 'atan (reverse (@2d (vlax-curve-getSecondDeriv Object MidParam))))) (not (equal Ba Ea 1e-8)) (setq P1 (polar V1 Ba 1.0)) (setq P2 (polar V2 Ea 1.0)) (setq Center (inters V1 P1 V2 P2 nil)) (setq Radius (distance Center V1)) (setq Ba (angle Center V1)) ; Beginning angle (setq V2 (vlax-curve-getpointatparam Object (1+ Param))) (setq Ea (angle Center V2)) ; End angle (setq Ma (angle Center (vlax-curve-getpointatparam Object MidParam))) ; Mid angle (setq MidP (trans (vlax-curve-GetPointAtParam Object MidParam) 0 1)) ;; Since we don't have the value of bulge, and since the internal angle (Delta) ;; can be > pi, cut the segment in half and add up the separate deflections: (setq Delta (+ (@delta Ba Ma)(@delta Ma Ea))) ;; If you had a Tan function, then you could ;; (setq Bulge (Tan (/ Delta 4))) (or (> Delta 0) (setq Swap Ba Ba Ea Ea Swap) ) (setq Ang (angle Center (trans PIQ 1 0))) (if (@Insect Ang Ba Ea) (setq P (trans (polar Center Ang Radius) 0 1) P (@Closest P) PParam (vlax-curve-GetParamAtPoint Object (trans P 1 0)) ) ) (cond ((or (not PParam)(= PParam MidParam)) (@Deflect MidP 3) ; in UCS ) ((< PParam MidParam) (@Deflect P 1) ; in UCS (@Deflect MidP 3) ; in UCS ) ((> PParam MidParam) (@Deflect MidP 3) ; in UCS (@Deflect P 1) ; in UCS ) ) ) ) (defun @Deflect (P Color) (setq a2 (angle PIQ P) ; in UCS Defl (+ Defl (@delta a1 a2)) a1 a2 ) ;(if Draw (grdraw PIQ P Color)) ) ;;========================================================= ;; Begin input validation and processing using the ;; Steph(and) Koster approach which simply stops evaluating ;; on any nil result: (and ;; Validate input object: (cond ((not Object) (prompt " No object provided.") ) ((= (type Object) 'VLA-Object)) ((= (type Object) 'Ename) (setq Object (vlax-ename->vla-object Object)) ) (1 (prompt " Improper object type.")) ) ;; Validate input point: (or (and (< 1 (vl-list-length PIQ) 4) (vl-every 'numberp PIQ) ) (prompt " Improper point value.") ) ;; Validate that object is a curve: (or (not (vl-catch-all-error-p (setq Start (vl-catch-all-apply 'vlax-curve-getStartPoint (list Object) ) ) ) ) (prompt " Object is not a curve.") ) ;; Validate that curve is closed: (or (equal Start (vlax-curve-getendpoint Object) 1e-10) (prompt " Curve is not closed.") ) (setq Closest (@Closest PIQ)) ; in UCS ;; Test to see if PIQ is on object: (not (equal (@2D PIQ)(@2D Closest) 1e-10)) ; in WCS (setq ClosestParam (vlax-curve-getparamatpoint Object (trans Closest 1 0))) (or (not Draw) (not (grdraw PIQ Closest 2))) (setq IsPolyline (wcmatch (vla-get-objectname Object) "*Polyline") End (vlax-curve-getEndparam Object) ) ;; Set the sample rates based on object type and end parameter. (cond (IsPolyline (setq ClosestParam nil) (setq Sample 1.0) ) ((equal (rem End pi) 0.0 1e-10) (setq Sample (* pi 0.2)) ) ((setq Sample (* End 0.01))) ) ;; Initialize the values to be incremented and computed: (setq Param Sample Defl 0.0) (setq a1 (angle PIQ (trans Start 0 1))) ; in UCS ;; Iterate through the object by parameter: (while (<= Param End) (setq Param (min Param End)) ;; This little extra makes sure not to skip an angle ;; that might throw off the total deflection. ;; It is at the top of while loop in case ClosestParam ;; is less than the first sample. ;; This is not to be used with polylines. (if (and ClosestParam (> Param ClosestParam)) (setq P Closest ClosestParam nil NextParam Param Color 2 ) (setq P (trans (vlax-curve-getpointatparam Object Param) 0 1) NextParam (+ Param Sample) Color 3 ) ) (@Deflect P Color) ; in UCS ;; For polylines check for additional points on any ;; bulged segment. (if IsPolyline (@Bulge Param)) (setq Param NextParam) ) ;(if Draw (print Defl)) ; Optional display of results (> (abs Defl) 4) ; to allow for rough calculations if ; sample rates are too high (large). ) )

Hello friends, I recently was thinking on how to entmake an arc with 2 points and a radius, and since I couldn't find a solution without knowing the center point created this solution by using a lwpolyline, I don't know if it ever is useful for you or not, but if it ever happens to be useful to you give me a like or just credit. ;;; Program to create a curved lwpolyline with 2 points and a radius ;;; By Isaac A. 20220523 ;;; V1.1 (defun c:parc (/ bcal cw end r start) (while (= nil (setq start (getpoint "\nPick the start point"))) (setq start (getpoint "\nPick the start point")) ) (while (= nil (setq end (getpoint "\nPick the end point"))) (setq end (getpoint "\nPick the end point")) ) (setq r (getreal "\nGive me the radius: ")) (while (< r (/ (distance start end) 2.)) (setq r (getreal (strcat "\nThe radius can't be less than " (rtos (/ (distance start end) 2.) 2 2) ": "))) ) (setq bcal (ia:bulge start end r)) (initget 1 "Clockwise counterclockWise") (setq cw (getkword "\nSelect the path of the arc Clockwise/counterclockWise: ")) (if (= cw "Clockwise") (setq bcal (* -1 bcal)) ) (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(8 . "newlayer") '(62 . 5) '(38 . 0.0) (cons 90 2) '(70 . 0) (cons 10 start) (cons 42 bcal) (cons 10 end) '(42 . 0.) ) ) (princ) ) ;;; ia:bulge Obtains the bulge to be used on a curved lwpolyline ;;; based on 2 points and radius (defun ia:bulge (p1 p2 r / d d-2 d-4 n) (setq d (distance p1 p2)) (if (>= r (/ d 2)) (progn (setq n (/ d (* 2. r)) d-2 (cond ((equal n 1. 1e-9) (/ pi 2.)) ((equal n -1. 1e-9) (/ pi -2.)) ((< -1. n 1.) (atan n (sqrt (- 1 (expt n 2)))) ) ) d-4 (/ d-2 2.) ) (/ (sin d-4) (cos d-4)) ) (princ "\nThe radius is incorrect") ) ) Hoping it ever gets useful to anyone. Happy coding.