Leaderboard
Popular Content
Showing content with the highest reputation since 01/04/2026 in Posts
-
I'm interested in where this topic will be going with the different "side quests" like islands and inlets. In the mean time I kept going, trying to fix my version and after a lot of testing/debugging I changed to code again. Now it is working as expected on all of the examples I have found! ;| ; Calculate centerline between two polylines - dexus ; Function checks intersections of the offsets of two lines to create a middle/avarage line. ; https://www.cadtutor.net/forum/topic/98778-hybrid-parallel/page/7/#findComment-677877 ; Version / Date - Change ; 0.01 [19-11-2025] - Initial release ; 0.02 [27-11-2025] - Added corner support on negative side of crossing polylines ; 0.03 [28-11-2025] - Extra check using vertex to closest point as distance ; 0.04 [28-11-2025] - Added error function ; 0.05 [01-12-2025] - Improved distance check to prevent zigzag lines ; 0.06 [01-12-2025] - Check if offset can be used before adding points ; 0.07 [01-12-2025] - Improved side check on 3 points ; 0.08 [04-12-2025] - Don't compare startpoint to offset when eiter of the polylines is closed ; 0.09 [05-12-2025] - Add points for parallel end segments ; 0.10 [18-12-2025] - More checks for deleting lines and added dedicated function ; 0.11 [08-01-2026] - Support for multiple output lines of the offset function ; 0.12 [08-01-2026] - Bulges are transformed to lines to handle cocentric arcs ; 0.13 [08-01-2026] - Rewrote the _avarageAngle and _diffAngle function |; (defun c:cl (/ corners ent1 ent2 gap index loop maxlen offset offsetdistance org1 org2 parallel pts sides ss start te0 te1 te2 tmp1 tmp2 LM:ProjectPointToLine LM:intersections _addPoints _avarageAngle _checkOffset _checkSortDirection _copyPolyline _cornerOffset _deleteTmpLine _diffAngle _doOffset _getAnglesAtParam _polyline _side *error*) (defun *error* (st) (if (wcmatch (strcase st t) "*break,*cancel*,*exit*") (redraw) (princ (strcat "\nOops! Something went wrong: ") st) ) (mapcar '_deleteTmpLine (list ent1 ent2 te0 te1 te2)) (princ) ) ;| ; Deletes an object or list of objects ; @Param obj vla-object or list |; (defun _deleteTmpLine (obj) (cond ((null obj)) ((vl-catch-all-error-p obj)) ((= (type obj) 'list) (mapcar '_deleteTmpLine obj)) ((not (vlax-erased-p obj)) (vla-delete obj)) ) ) ;| ; Draw Polyline - dexus ; Draw a polyline from a list of points, but filter out colinear points ; @Param lst list of points ; @Returns ename of polyline |; (defun _polyline (lst closed / prev pts) (while lst (cond ( (and (cdr lst) prev (or (equal (cdr lst) prev 1e-8) ; Remove duplicate points (null (inters prev (car lst) prev (cadr lst))) ; Remove collineair points ) ) ) ((setq pts (cons (cons 10 (setq prev (car lst))) pts))) ) (setq lst (cdr lst)) ) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length pts)) (cons 8 (getvar 'clayer)) (cons 70 (if closed 1 0)) ) (reverse pts) ) ) ) (defun _copyPolyline (ent maxlen closed rev / bul pts index curve steps size next) (setq ent (vlax-ename->vla-object ent) index 0) (repeat (1+ (fix (vlax-curve-getEndParam ent))) (cond ( (and (not (vl-catch-all-error-p (setq bul (vl-catch-all-apply 'vla-getbulge (list ent index))))) (not (equal bul 0.0 1e-8)) (setq next (vlax-curve-getDistAtParam ent (1+ index))) (not (zerop (setq steps (fix (* (/ (- next (vlax-curve-getDistAtParam ent index)) maxlen) 45))))) ) (setq size (/ 1.0 steps) curve index) (repeat steps (setq pts (cons (vlax-curve-getPointAtParam ent curve) pts) curve (+ curve size)) ) ) ((setq pts (cons (vlax-curve-getPointAtParam ent index) pts))) ) (setq index (1+ index)) ) (_polyline (if rev (reverse pts) pts) closed) ) (defun _side (pline pnt / cpt end target der) ; https://www.theswamp.org/index.php?topic=55685.msg610429#msg610429 (setq cpt (vlax-curve-getClosestPointTo pline pnt) end (vlax-curve-getEndParam pline) target (vlax-curve-getParamAtPoint pline cpt) der (if (and (equal target (fix target) 1e-8) (or (vlax-curve-isClosed pline) (and (not (equal (vlax-curve-getStartParam pline) target 1e-8)) (not (equal end target 1e-8))) ) ) (mapcar '- (polar cpt (angle '(0 0) (vlax-curve-getFirstDeriv pline (rem (+ target 1e-3) end))) 1.0) (polar cpt (angle (vlax-curve-getFirstDeriv pline (rem (+ (- target 1e-3) end) end)) '(0 0)) 1.0) ) (vlax-curve-getFirstDeriv pline target) ) ) (minusp (sin (- (angle cpt pnt) (angle '(0.0 0.0) der)))) ) ;; Intersections - Lee Mac ;; mod - [int] acextendoption enum of intersectwith method (defun LM:intersections ( ob1 ob2 mod / lst rtn ) (if (and (vlax-method-applicable-p ob1 'intersectwith) (vlax-method-applicable-p ob2 'intersectwith) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) ) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst)) ) ) (reverse rtn) ) (defun _doOffset (offset / lst rtn) ; Global vars: pts ent1 ent2 sides te1 te2 (setq rtn (cond ((equal offset 0.0 1e-8) (if (setq lst (LM:intersections ent1 ent2 acExtendNone)) (setq pts (_addPoints lst ent1 ent2 pts)) ) lst ) ( (or ; Make offset (setq te1 nil) (vl-catch-all-error-p (setq te1 (vl-catch-all-apply 'vlax-invoke (list ent1 'Offset (if (car sides) offset (- offset)))))) (not (setq tmp1 (vl-some (function (lambda (te) (_checkOffset ent1 te offset))) te1))) (vla-put-visible tmp1 :vlax-false) ; (vla-put-color tmp1 252) (setq te2 nil) (vl-catch-all-error-p (setq te2 (vl-catch-all-apply 'vlax-invoke (list ent2 'Offset (if (cadr sides) offset (- offset)))))) (not (setq tmp2 (vl-some (function (lambda (te) (_checkOffset ent2 te offset))) te2))) (vla-put-visible tmp2 :vlax-false) ; (vla-put-color tmp2 252) ) (princ (strcat "\nOffset of " (rtos offset 2 4) " failed. ")) nil ) ((setq lst (LM:intersections tmp1 tmp2 acExtendNone)) (if parallel ; Add points of parallel end segments (mapcar (function (lambda (ent1 ent2) (mapcar (function (lambda (pt) (if (equal pt (vlax-curve-getClosestPointTo ent2 pt) 1e-10) (setq lst (cons pt lst)) ) )) (list (vlax-curve-getStartPoint ent1) (vlax-curve-getEndPoint ent1) ) ) )) (list tmp1 tmp2) (list tmp2 tmp1) ) ) (setq pts (_addPoints lst tmp1 tmp2 pts)) lst ) ) ) (_deleteTmpLine te1) (_deleteTmpLine te2) rtn ) ;| ; Check if the offset starts and ends at the correct point or is closed |; (defun _checkOffset (ent1 ent2 offset) (if (or (vlax-curve-isclosed ent1) (vlax-curve-isclosed ent2) (and (equal (distance (vlax-curve-getStartPoint ent1) (vlax-curve-getStartPoint ent2)) offset 1e-4) (equal (distance (vlax-curve-getEndPoint ent1) (vlax-curve-getEndPoint ent2)) offset 1e-4) ) ) ent2 ) ) (defun _addPoints (lst ent1 ent2 pts / len1 len2) (setq len1 (vlax-curve-getDistAtParam ent1 (vlax-curve-getEndParam ent1)) len2 (vlax-curve-getDistAtParam ent2 (vlax-curve-getEndParam ent2)) lst (vl-remove nil (mapcar (function (lambda (pt / d1 d2) (if (and (setq d1 (vlax-curve-getDistAtPoint ent1 pt)) (setq d2 (vlax-curve-getDistAtPoint ent2 pt)) ) (list (cons ( (lambda (ang) (if (cadr ang) (_avarageAngle (car ang) (cadr ang)))) (mapcar (function (lambda (ent) ( (lambda (ang) (if (cadr ang) (_avarageAngle (car ang) (cadr ang)))) (_getAnglesAtParam ent (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent pt))) ) )) (list ent1 ent2) ) ) (cond ((and (vlax-curve-isclosed ent1) (not (vlax-curve-isclosed ent2))) (list (/ d2 len2))) ((vlax-curve-isclosed ent2) (list (/ d1 len1))) ((list (/ d1 len1) (/ d2 len2))) ) ) pt ) ) )) lst ) )) (append lst pts) ) ;| ; Project Point onto Line - Lee Mac ; @Param pt point to project ; @Param p1 first point of line ; @Param p2 second point of line ; @Returns projected point |; (defun LM:ProjectPointToLine ( pt p1 p2 / nm ) (setq nm (mapcar '- p2 p1) p1 (trans p1 0 nm) pt (trans pt 0 nm)) (trans (list (car p1) (cadr p1) (caddr pt)) nm 0) ) (defun _getAnglesAtParam (ent pa / ang1 ang2) (if (and (vlax-curve-isClosed ent) (= pa 0)) ; Special case for closed Polyline (setq ang1 (vlax-curve-getFirstDeriv ent 1e-14) ang2 (vlax-curve-getFirstDeriv ent (- (fix (vlax-curve-getEndParam ent)) 1e-14))) (setq ang1 (vlax-curve-getFirstDeriv ent (+ pa 1e-14)) ang2 (vlax-curve-getFirstDeriv ent (- pa 1e-14))) ) (if (and ang1 ang2) (list (angle '(0 0 0) ang1) (angle '(0 0 0) ang2) ) ) ) ;| ; Avarage Angle - dexus ; Get angle of a line between two angles ; @Param ang1 real - Angle in radians ; @Param ang2 real - Angle in radians ; @Returns real - Angle in radians |; (defun _avarageAngle (ang1 ang2 / dif) (setq dif (- ang1 ang2)) (if (< pi (abs dif)) (+ ang1 (* (- (+ pi pi) (abs dif)) (if (minusp dif) -0.5 0.5) ) ) (+ ang2 (* dif 0.5)) ) ) ;| ; Difference between angles - dexus ; Retuns the angle between two angles ; @Param ang1 real ; @Param ang2 real ; @Returns real |; (defun _diffAngle (ang1 ang2) ( (lambda (ang) (if (> ang pi) (- (+ pi pi) ang) ang ) ) (abs (- ang2 ang1)) ) ) ;| ; Check which of two poits is closer to the expected angle of the line ; @Param a (list (list angle) point) ; @Param b (list (list angle distance1 distance2) point) ; @Returns true if a is after b |; (defun _checkSortDirection (a b) (and (caar a) (caar b) (< (abs (_diffAngle (angle (cadr a) (cadr b)) (caar a))) (abs (_diffAngle (angle (cadr b) (cadr a)) (caar b))) ) ) ) ;| ; Calculate exact offset distance on a corner - dexus ; pt1 - Point on corner ; pt2 - Point on other side ; pt3 - Center for bisector ; pt4 - Target for corner of the offset ; pt5 - Find perpendicular point for offset distance ; / ; / ; -------- pt1 pt5 ; \ / ; pt4 ; \ ; ---- pt3 ----- pt2 ----- ; ; @Param ent1 Line to check corners ; @Param ent2 Opposing line ; @Returns List of offset distances (pt1 -> pt5) to calculate |; (defun _cornerOffset (ent1 ent2 / ang1 ang1a ang2 ang3 index pt1 pt2 pt3 pt4 pt5 rtn) (setq index 0) (repeat (fix (vlax-curve-getEndParam ent1)) (and (setq pt1 (vlax-curve-getPointAtParam ent1 index)) ; Point on corner (setq ang1 (_getAnglesAtParam ent1 index)) ; Angles of pt1 (setq ang1a (_avarageAngle (car ang1) (cadr ang1))) (setq te0 (entmakex (list (cons 0 "line") (cons 10 pt1) (cons 11 (polar pt1 (- ang1a halfPi) 1))))) ; Temp line for finding the angle on the other side (foreach pt2 (LM:intersections (vlax-ename->vla-object te0) ent2 acExtendThisEntity) ; Point on other side (and (setq ang2 (_getAnglesAtParam ent2 (vlax-curve-getParamAtPoint ent2 pt2))) ; Angle of pt2 (if (equal (rem (car ang1) pi) (rem (car ang2) pi) 1e-8) ; Is parallel? (and (setq parallel (or parallel (< index 1) (<= (fix (vlax-curve-getEndParam ent1)) (1+ index)) t)) ; End of line is parallel (setq pt3 (mapcar (function (lambda (a b) (* (+ a b) 0.5))) pt1 pt2)) ; Midpoint (setq ang3 (car ang1)) ; Same angle als ang1 ) (and (setq pt3 (inters pt1 (polar pt1 (car ang1) 1) pt2 (polar pt2 (car ang2) 1) nil)) ; Find center for bisector (setq ang3 (_avarageAngle (angle pt1 pt3) (angle pt2 pt3))) ; Angle of bisector ) ) (setq pt4 (inters pt3 (polar pt3 ang3 1) pt1 (polar pt1 (+ ang1a halfPi) 1) nil)) ; Find target for corner of the offset (setq pt5 (LM:ProjectPointToLine pt4 pt1 (polar pt1 (+ (car ang1) halfPi) maxlen))) ; Find perpendicular point for offset distance (setq rtn (cons (distance pt1 pt5) rtn)) ; Return offset distance ) ) ) (if (and te0 (not (vlax-erased-p te0))) (entdel te0)) (setq index (1+ index)) ) rtn ) (if (and (not (while (cond ((not (setq ss (ssget '((0 . "LWPOLYLINE"))))) (princ "\nNothing selected. Try again...\n") nil ) ((/= (sslength ss) 2) (princ "\nSelect 2 polylines! Try again...\n") ) ((and (setq org1 (ssname ss 0)) (setq org2 (ssname ss 1))) nil ; Stop loop ) ) ) ) org1 org2 ) (progn (if (not (numberp halfPi)) (setq halfPi (* pi 0.5))) (setq maxlen (* 1.1 (max (vlax-curve-getDistAtParam org1 (vlax-curve-getEndParam org1)) (vlax-curve-getDistAtParam org2 (vlax-curve-getEndParam org2)) ( (lambda (ent1 ent2 / step de1 div p_step dis dmax) (setq step (/ (setq de1 (vlax-curve-getDistAtParam ent1 (vlax-curve-getEndParam ent1))) 500) div step dmax 0.0) (while (< div de1) (setq p_step (vlax-curve-getPointAtDist ent1 div) dis (distance p_step (vlax-curve-getClosestPointTo ent2 p_step))) (if (> dis dmax) (setq dmax dis)) (setq div (+ div step)) ) dmax ) org1 org2 ) ) ) ) ; Convert first line (setq ent1 (_copyPolyline org1 maxlen (vlax-curve-isClosed org1) nil)) (setq ent1 (vlax-ename->vla-object ent1)) (vla-put-visible ent1 :vlax-false) ; Convert second line (setq ent2 (_copyPolyline org2 maxlen (vlax-curve-isClosed org2) (< (distance (vlax-curve-getStartPoint org1) (vlax-curve-getEndPoint org2)) (distance (vlax-curve-getEndPoint org1) (vlax-curve-getEndPoint org2)) ) )) (setq ent2 (vlax-ename->vla-object ent2)) (vla-put-visible ent2 :vlax-false) ; Get offset direction (setq sides (mapcar (function (lambda (a b / s m e) (setq s (_side a (vlax-curve-getStartPoint b)) m (_side a (vlax-curve-getPointAtParam b (* 0.5 (vlax-curve-getEndParam b)))) e (_side a (vlax-curve-getEndPoint b))) (or (and s m) (and s e) (and m e)) )) (list ent1 ent2) (list ent2 ent1) ) ) (mapcar ; Add half distances from closest point to every vertex (function (lambda (ent1 ent2 / index pt) (setq index 0) (repeat (fix (vlax-curve-getEndParam ent1)) (setq pt (vlax-curve-getPointAtParam ent1 index) corners (cons (* (distance pt (vlax-curve-getClosestPointTo ent2 pt)) 0.5) corners) index (1+ index)) ) )) (list ent1 ent2) (list ent2 ent1) ) (setq corners (vl-sort (append corners (_cornerOffset ent1 ent2) (_cornerOffset ent2 ent1)) '<) offsetdistance (/ maxlen 256.0)) (if (LM:intersections ent1 ent2 acExtendNone) ; For crossing polylines, add negative values (setq offset (- maxlen) corners (append (mapcar '- (reverse corners)) corners)) (setq offset 0.0) ) (setq index 0) (setq gap (getvar 'offsetgaptype)) (setvar 'offsetgaptype 0) (while (progn (while (and corners (> offset (car corners))) ; Calculated offset values to check (_doOffset (car corners)) (setq index (1+ index)) (setq corners (cdr corners)) ) (setq loop ; Incremental check (cond ((> offset maxlen) nil) ((_doOffset offset) (setq index (1+ index)) (setq start t)) ((not start) t) (start nil) ) ) (setq offset (+ offset offsetdistance)) loop ) ) (setvar 'offsetgaptype gap) (if pts ; Draw polyline (_polyline (mapcar 'cadr (vl-sort pts (function (lambda (a b / ang) (if (and (caddar a) (caddar b)) (if (< (cadar a) (cadar b)) (or (< (caddar a) (caddar b)) (_checkSortDirection a b)) (and (< (caddar a) (caddar b)) (_checkSortDirection a b)) ) (< (cadar a) (cadar b)) ) )) ) ) (and (vlax-curve-isClosed ent1) (vlax-curve-isClosed ent2) ) ) ) (_deleteTmpLine ent1) (_deleteTmpLine ent2) (if (and ent2 (not (vlax-erased-p ent2))) (vla-delete ent2)) ) ) (princ) ) River result:7 points
-
Their IT department even has a slogan (and I'm not kidding here) : You name it , we block it4 points
-
The reason I clean the drawing is I once wrote a program to generate instrument loop diagrams from an excel file. I found the most stable and easy way was not to use a script but stay in the current drawing and from there save(as) each loop. I also made use from templates and also had the option to update the drawing in stead of generating the entire drawing. But at some time some templates had been given an update to a block definition and to be certain the latest version was used I had to make sure the old block was purged. Overkill , some times yes , but in my case it worked as it should. In this case , dxfin , probably overkill , but it doesn't hurt either. I tested it on Bricad 22 and the dwg extension was no problem, it worked as it should. The recommendation from the annoying paperclip oh , sorry , AI its called these days , to pimp the filename and use vla-saveas is not wrong though. Just didn't need it on my computer. Had it gave me an error I would have fixed it but it worked right from the start for me.4 points
-
Another - (defun c:test ( / e i s x ) (if (setq s (ssget "_X" '((0 . "LINE")))) (repeat (setq i (sslength s)) (setq i (1- i) e (ssname s i) x (entget e) ) (if (not (equal (cadr (assoc 10 x)) (cadr (assoc 11 x)) 1e-8)) (ssdel e s) ) ) ) (sssetfirst nil s) (princ) )3 points
-
This version should work in all cases, regardless of the complexity of the polygons ;******************* p o r d e s i a r g o ******************** ;************************ G L A V C V S ************************* ;************************** F E C I T *************************** (defun c:RectOffBatch (/ selset dist i ent pts offsetpt a70 es l le p1 p2 o sDir) (defun sDir (le i? / p1 p2 p ar ang ab dir tl) (foreach l le (if (and (= (car l) 10) (setq p (cdr l))) (progn (if p2 (if p1 (setq dir (cond ((< (abs (setq ang (- (setq ar (angle p1 p2)) (setq ab (angle p2 p))))) PI) ang) (T (if (<= ar PI) (+ ar (- (* 2 PI) ab)) (- (- ar (* 2 PI)) ab))) ) ) ) ) (if dir (setq tl (+ (if tl tl 0) dir))) (setq p1 p2 p2 p dir nil) ) ) ) (if (minusp tl) (if i? + -) (if i? - +)) ) (prompt "\nSelect rectangles (polylines): ") (setq selset (ssget '((0 . "*POLYLINE")))) (vl-cmdf "_.CONVERTPOLY" "_Light" selset "") (if selset (if (setq i -1 dist (getdist "\nEnter the offset distance: ")) (repeat (sslength selset) (setq ent (ssname selset (setq i (1+ i)))) (setq o (sDir (setq le (entget ent)) nil)); <-- CHANGE 'nil' TO 'T' FOR OFFSET INWARD TOWARD INTERIOR OF THE POLYGONS (if (= (rem (cdr (setq a70 (assoc 70 le))) 2) 0) (entmod (subst (cons 70 (+ (cdr a70) 1)) a70 le))) (setq pr (vlax-curve-getPointAtParam ent 0.5)) (setq offsetpt (polar pr (o (angle (vlax-curve-getPointAtParam ent 0) pr) (/ PI 2.)) 0.1)) (command "_.OFFSET" dist ent offsetpt "") ) ) ) (princ) )3 points
-
I'll this topic a "wrap" Thanks to all here! rlx: I also have worked at my last company of fifteen years within a very locked down IT environment. Here and now, I am free! One caveat here is that there are limitations in acquiring additional Microsoft tools i.e., Power Platform tools, etc. due to the complexity introduced from being a client of an widely known commercial web hosting service. Happy, happy, happy! Clint3 points
-
Yikes! Working with your arms tied.. No way I could work effectively without my tools, I would at least need autohotkey. Last company I worked for, I automated their whole system, mostly because I was lazy and I wanted to eat donuts all day. AutoCAD ships with .NET, nothing to install, I would be rolling some goodies for sure. “We At ACME corporation stifle innovation by making everyone think inside the box”3 points
-
Use this and simply switch: *dist* (- *dist*) To: (- *dist*) *dist*3 points
-
This was my 'Offset Inside' program: ;; Offset Inside - Lee Mac - www.lee-mac.com ;; Offsets a set of objects by a specified distance to the inside. (defun c:OffInside ( / acsel pos ) (if (and (setq *dist* (cond ( (getdist (strcat "\nOffset Distance" (if *dist* (strcat " <" (rtos *dist*) ">: ") ": ") ) ) ) ( *dist* ) ) ) (ssget '( (-4 . "<OR") (0 . "CIRCLE,ARC,ELLIPSE") (-4 . "<AND") (0 . "LWPOLYLINE,SPLINE") (-4 . "&=") (70 . 1) (-4 . "AND>") (-4 . "<AND") (0 . "POLYLINE") (-4 . "&=") (70 . 1) (-4 . "<NOT") (-4 . "&") (70 . 120) (-4 . "NOT>") (-4 . "AND>") (-4 . "OR>") ) ) ) (progn (vlax-for obj (setq acsel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)) ) ) (vl-catch-all-apply 'vla-offset (list obj (if (and (setq pos (vl-position (vla-get-objectname obj) '("AcDbPolyline" "AcDb2dPolyline"))) (LM:ListClockwise-p (LM:GroupByNum (vlax-get obj 'coordinates) (+ pos 2))) ) *dist* (- *dist*) ) ) ) ) (vla-delete acsel) ) ) (princ) ) ;; List Clockwise-p - Lee Mac ;; Returns T if the point list is clockwise oriented (defun LM:ListClockwise-p ( lst ) (minusp (apply '+ (mapcar (function (lambda ( a b ) (- (* (car b) (cadr a)) (* (car a) (cadr b))) ) ) lst (cons (last lst) lst) ) ) ) ) ;; Group by Number - Lee Mac ;; Groups a list into a list of lists, each of length 'n' (defun LM:GroupByNum ( l n / r) (if l (cons (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r)) (LM:GroupByNum l n) ) ) ) (vl-load-com) (princ)3 points
-
2 points
-
How about something like this, is that what you are looking for? (defun draw (pt1 pt2 len) (if (and pt1 pt2 len) (progn (entmakex (list '(0 . "LINE") (cons 10 pt1) (cons 11 (polar pt1 (angle pt1 pt2) len)) ) ) (entmakex (list '(0 . "LINE") (cons 10 (polar pt2 (angle pt2 pt1) len)) (cons 11 pt2) ) ) ) ) (princ) ) (draw (getpoint "\nFirst point: ") (getpoint "\nSecond point: ") (getdist "\nLine Length: ") )2 points
-
Just use: (command "_.OFFSET" dist ent "_non" offsetpt "") And you no longer need to worry about OSMODE.2 points
-
You would still need Visual Studio or similar and packages installed. Even for Visual Studio Code and LISP, I get PowerShell errors due to IT blocking it as well as the need to download the extension. Main issue is just lazy IT departments not wanting to due proper security, every issue I have had a work shows "improper server configuration" and/or "improper firewall configuration" when searching the issue. Anyone using Autodesk products (maybe other programs as well) has to manually override the proxy server on each restart of their computer or we have licensing issues. I had to to do all of the leg work on getting that issue resolved. Unfortunately that's just how many IT "professionals" are trained, "when in doubt, block it out". I normally don't have issues getting programs installed, just usually they are in no hurry to get it done. Autodesk is partly to blame, should be a better way to get apps, add-ons, etc. than needing an IT install. Even Microsoft, why do I need to update Windows and MS Office tools separately and need IT to allow use of PowerShell? To be honest though, I am just the AutoCAD guy, so they don't understand how programming with other tools is relevant.2 points
-
If you want to change the offset direction, you just need to change the 'i?' parameter used to call 'sDir' from 'nil' to 'T' (as indicated in the code comment). Nikon2.mp4 PS: The video shows the execution of the code with 'i?' set to 'T'.2 points
-
I tested the code on your drawing and it works correctly. Perhaps you didn't use it correctly. Nikon1.mp42 points
-
For most things I do this is my default option, rarely need to do much other than that and if I do, drag and drop.2 points
-
There's an app for that: https://apps.autodesk.com/ACD/en/Detail/Index?id=3434696327413675915&appLang=en&os=Win32_642 points
-
A simple script made with notepad. Open dwg1.dxf qsave dwg1 close Open dwg2.dxf qsave dwg2 close Open dwg3.dxf qsave dwg3 close Open dwg3.dxf qsave dwg3 close The dwg1 would be like "C:\\mydxfiles\\project123\\dwg1" There are various ways to make a list of dwg names, how many are we talking about ?2 points
-
This is one I was looking at yesterday, sharing here because I am really 12.... 'WipeBottom' will move the defined entity types to the Bottom or Top draw order in a selected block definition. Define the entity types and move direction in the code. Made up because I wanted to split out the selection part of the examples online and use the 2nd part via LISP without user interface. Via LISP I only wanted it to process a single block at a time - selection set processing can be from the calling LISP. Examples out there mostly from Lee Mac - see his website or the link in the code. But apart from that I really wanted to use the LISP command name. (defun c:WIPEBOTTOM ( / MyName MoveType MoveDirection) ;;AcDbTypes: AcDb + .... replace 'movetype' below with these as required ;;AcDbEntity, AcDbLine, AcDbCircle, AcDbArc, AcDbPolyline, AcDbText, AcDbMText ;;AcDbBlockReference, AcDbPoint, AcDbEllipse, AcDbSpline, AcDbHatch, AcDbTable ;;AcDbRasterImage, AcDbLeader, AcDbRay, AcDbXline, AcDbTrace, AcDbWipeout ;;AcDbDimension, AcDbAlignedDimension, AcDbRadialDimension, AcDbDiametricDimension ;;AcDb3PointAngularDimension, AcDbArcDimension, AcDbOrdinateDimension ;;MoveDirections: vla-movetobottom, vla-movetotop (Setq MyName (cdr (assoc 2 (entget (car(entsel "Select Block")))))) ;; block name (setq MoveType "AcDbHatch") (setq MoveDirection "vla-MoveToBottom") (WIPEBOTTOM MyName MoveType MoveDirection) (setq MoveType "AcDbWipeout") (setq MoveDirection "vla-MoveToBottom") (WIPEBOTTOM MyName MoveType MoveDirection) (setq MoveType "AcDbText") (setq MoveDirection "vla-MoveToTop") (WIPEBOTTOM MyName MoveType MoveDirection) ;; MyName: Real Block Name (example "MyBlock"), MoveType "ACDb....", MoveDirection "VLA-MoveTo..." (princ) ) (defun WIPEBOTTOM ( name MoveType MoveDirection / acblk acdoc obj name MoveType) ;;https://www.cadtutor.net/forum/topic/31462-wipeout-inside-blocks-issue/ ;;updated to single block selections only refer to link for selection sets ;Lee Mac 17.06.11 (defun LM:SortentsTable ( space / dict result ) (cond ((not (vl-catch-all-error-p (setq result (vl-catch-all-apply 'vla-item (list (setq dict (vla-GetExtensionDictionary space)) "ACAD_SORTENTS") ) ) ) ) result ) ; end not ( (vla-AddObject dict "ACAD_SORTENTS" "AcDbSortentsTable") ) ) ) ; end defun (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) ;;ACDoc reference (setq acblk (vla-get-blocks acdoc)) ;ACBlocks references (if name (progn ((lambda ( / lst ) (vlax-for obj (vla-item acblk name) ;;name: Block name. For each object in block (if (eq MoveType (vla-get-objectname obj)) ;;if object is required type (setq lst (cons obj lst)) ;; add to list ) ; end if ) ; end vlax-for (if lst (progn ( (eval (read MoveDirection)) ;; turn text move direction into command (LM:SortentsTable (vla-item acblk name)) ;; Sort objects - make into variable and only process once? (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length lst)))) lst )) ; end vlax-make-variant ) ; end vla-move (vla-regen acdoc acallviewports) ;; move to after lambda?? )) ; end if ; end progn )) ; end lambda ) ;; end progn ) ;; end if name )1 point
-
Hehe reminds me of when I made a shortcut command for one of our customs lisp "Assembly populate".1 point
-
I think you might be getting caught up on the cadr? the list its looking at has the 10 and 11 as the first element so the 2nd element is going to be the x value. (10 370477.766247702 2284988.06147298 0.0) & (11 370477.775905386 2284983.23263075 0.0) the 1e-8 is to aggressive for @Isaac26a sample drawing that is why I added a dynamic fuzz the user can pick if they want true vertical lines just input 0. I started with the x value comparison, but isn't a good option for angled lines as it changes for lines of the same same angle but different lengths. and if you increase to pick up longer lines it will picked shorter lines that have a greater angle.1 point
-
1 point
-
Lee's code is above my pay grade. He has CB and RB broken out already maybe ask him nicely to add a feature. RBP - rename block with prefix RBS - rename block with Suffix -edit I think I have code that will do this for regular blocks or maybe it was for text. its been awhile.1 point
-
This ? in dynamic mode... ((lambda ( / pt1 pt2 gap) (initget 1) (setq pt1 (getpoint "\nPick on 1st beam cl: ") pt2 pt1 gap 200 ) (while (equal pt2 pt1) (setq pt2 ((lambda ( / key pt alpha spane crnkL p1 p2) (princ "\nPick 2nd beam cl: ") (while (and (setq key (grread T 4 0)) (/= (car key) 3)) (cond ((eq (car key) 5) (redraw) (setq pt (cadr key)) (setq alpha (angle pt1 pt)) (setq spane (distance pt1 pt)) (setq crnkL (* 0.3 spane)) (cond ((and (>= alpha 0.0) (< alpha (* pi 0.5))) (setq p1 (polar pt (+ alpha ( * 0.5 pi)) gap) p2 (polar p1 (+ alpha pi) crnkL) ) ) ((and (>= alpha (* pi 0.5)) (< alpha pi)) (setq p1 (polar pt (+ alpha ( * 0.5 pi)) gap) p2 (polar p1 (+ alpha pi) crnkL) ) ) ((and (>= alpha pi) (< alpha (* 0.75 pi))) (setq p1 (polar pt (- alpha ( * 0.5 pi)) gap) p2 (polar p1 (+ alpha pi) crnkL) ) ) (T (setq p1 (polar pt (- alpha ( * 0.5 pi)) gap) p2 (polar p1 (+ alpha pi) crnkL) ) ) ) (grdraw pt1 pt 3) (grdraw p1 p2 1) ) ) ) (redraw) (cadr key) )) ) ) (prin1) ))1 point
-
Thank you Mhupp, it works like charm, I didn't know that '(equal )' would work like that, I thought that would return nil everytime, something new to learn, thank you again for your help.1 point
-
ssget lines check endpoints to get angle tho not so vertical. vert.mp4 SVL.lsp1 point
-
I have a drawing with multiple rotated dimensions and some are quite small resulting in text being offset to the leader. I was wondering if there is an easy way to change all the text box components of the dimensions to fit the actual size of the text so that it isn't so offset from the leader without exploding all the dimensions. I've included some snap shots below for reference. There are quite a few in the file so I want to try and avoid having to do them manually one by one. Any help would be greatly appreciated. Regards, Ryan1 point
-
You are correct, need the .NET SDK, and Extensions to build modules with Visual Studio Code. It’s been a while since I’ve done .NET, I think version 4 had the compiler, you could build with notepad and the command line ugh BTW, I’ve had companies reach out to me to support zero-install Python packages for AutoCAD. They wanted to validate the modules, and block PIP. Basically it’s: 1, Grab Python embedded package from the Python site, it’s a minimal, portable zipped interpreter for Windows. 2, add the most commonly used packages, pyrx, pyopenxl, pypdf, genre specific tools, like shapely, or gdal 3, deploy it as a .bundle. I've been meaning to write something about this, lazy i guess lol1 point
-
Add this code below '(command " rectangle"... ', load it, and try running the code again (if (not (tblsearch "block" roomName)) (command "_block" roomName (setq pt (list (min (car fc) (car fc)) (min (cadr fc) (cadr fc)))) (setq cj (ssadd (entlast))) "") (princ (strcat "\n" roomName " already exist...")) ) (command "_.insert" roomName pt "" "" "")1 point
-
That's definitely the best option. Thank you, @Lee Mac1 point
-
I forgot to mention that: I haven't done anything with 'osmode' because I think it's convenient to manage it from the F3 key at runtime: you can activate or deactivate it during command execution by pressing F3.1 point
-
So that it only offsets outwards, for example, like this (defun c:RectOffBatch (/ selset dist i ent pts offsetpt a70 es l le p1 p2 a midP) (prompt "\nSelect rectangles (polylines): ") (setq selset (ssget '((0 . "*POLYLINE")))) (vl-cmdf "_.CONVERTPOLY" "_Light" selset "") (if selset (progn (setq dist (getdist "\nEnter the offset distance: ") i 0) (repeat (sslength selset) (setq ent (ssname selset i)) (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (setq le (entget ent))))) (if (= (rem (cdr (setq a70 (assoc 70 le))) 2) 0) (entmod (subst (cons 70 (+ (cdr a70) 1)) a70 le))) (setq midP (mapcar '(lambda(v) (/ v (length pts))) (apply 'mapcar (cons '+ pts)))) (setq offsetpt (polar (car pts) (angle midP (car pts)) 0.01)) (command "_.OFFSET" dist ent offsetpt "") (setq i (1+ i)) ) ) ) (princ) )1 point
-
As I said I did some testing about method, just get your closed plines, then check there CW or CCW direction and change if needed. Then use (getvar 'extmax) as offset point.In code below I use pedit "R" as the Reverse command is not available in Bricscad. CCW is offset out for a positive value using VLA-Offset. ; Checking if pline is CW or CCW and set to CCW ; Orignal idea by Kent Cooper, 1 August 2018 Offsetinorout.lsp ; By Alan H July 2020 (defun AH:chkcwccw (ent / objnew area1 area2 obj minpoint maxpoint) (setq obj (vlax-ename->vla-object ent)) (vla-GetBoundingBox obj 'minpoint 'maxpoint) (setq pointmin (vlax-safearray->list minpoint)) (setq pointmax (vlax-safearray->list maxpoint)) (setq dist (/ (distance pointmin pointmax) 20.0)) (vla-offset obj dist) (setq objnew (vlax-ename->vla-object (entlast))) (setq area1 (vlax-get objnew 'Area)) (vla-delete objnew) (vla-offset obj (- dist)) (setq objnew (vlax-ename->vla-object (entlast))) (setq area2 (vlax-get objnew 'Area)) (vla-delete objnew) (if (> area1 area2) (command "Pedit" ent "R" "") ) (princ) )1 point
-
(70 . 1) or (70 . 128) will filter a selection set for closed polyline - (70 . 1) is usually enough1 point
-
PS: 2D polylines do not support offset, so they need to be converted first. I haven't tested it extensively, but it should work for what you need.1 point
-
If the polygons aren't too irregular, using your own code, maybe this... (defun c:RectOffBatch (/ selset dist i ent pts maxpt offsetpt a70 es l le p1 p2 a) (prompt "\nSelect rectangles (polylines): ") (setq selset (ssget '((0 . "*POLYLINE")))) (vl-cmdf "_.CONVERTPOLY" "_Light" selset "") (if selset (progn (setq dist (getreal "\nEnter the offset distance or ENTER to indicate on screen: ")) (setq p1 (getpoint "\nPick on/near one of the rectangles to be offset...")) (if (and (setq es (car (nentselp p1))) (= (wcmatch (cdr (assoc 0 (entget es))) "LWP*"))) (progn (setq p2 (getpoint p1 "\nPoint to get direction (or distance) to offset: ")) (if (not dist) (setq dist (distance p1 p2))) (setq l (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget es)))) (setq midP (mapcar '(lambda(v) (/ v (length l))) (apply 'mapcar (cons '+ l)))) (setq a (if (> (distance p1 midP) (distance p2 midP)) 0 PI) i 0 ) (repeat (sslength selset) (setq ent (ssname selset i)) (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (setq le (entget ent))))) (if (= (rem (cdr (setq a70 (assoc 70 le))) 2) 0) (entmod (subst (cons 70 (+ (cdr a70) 1)) a70 le))) (setq maxpt (list (apply 'max (mapcar 'car pts)) (apply 'max (mapcar 'cadr pts)))) (setq midP (mapcar '(lambda(v) (/ v (length pts))) (apply 'mapcar (cons '+ pts)))) (setq offsetpt (polar (car pts) (+ a (angle (car pts) midP)) 0.01)) (command "_.OFFSET" dist ent offsetpt "") (setq i (1+ i)) ) ) ) ) ) (princ) )1 point
-
What they're talking about, I believe, is a matter of fairness. You ask for help but provide none in return. Most of us have other commitments, but we make time to teach and to help others. Not only that, learning a bit about AutoLISP will make your work easier and faster.1 point
-
Even if I wanted to use a different language I wouldn't be able because at my work I'm unable to install any software that's not supplied in our software center , also certain extensions like *.bat are a big freaking no no so my dragon claws are tied in that respect. But I can get vl-some satisfaction however whenever I can create something that at first glance seems impossible to do and then come up with something that actually works.1 point
-
What programming language to use ? There are so many, Lisp, Pascal, VBA, C##, now .NET, Python and of course the push product by Autodesk Dynamo but only on certain platforms. Yeah the macro record almost useless. As I have said before years ago macro record in a CAD program wrote VBA code. There is lisp2C from years ago that converted lisp code to C## code, hey Daniel what about convert lisp to Python ? The main advantage in lisp is the non compile, just run, I use code that is 30+ years old still works. Any compiled code every few years has to be recompiled to work as versions change. Dont forget how many years ago now Autodesk said VBA support would be removed, it's still there.1 point
-
A couple of answers, as suggested, check is closed pline ie a rectang drawn CW or CCW then vla-offset will always go out for a CCW pline. You can do a check and reverse the pline if required. Or the simpler is (setq offsetpt (getvar 'extmax))1 point
-
It’s more of, ‘pick the right tool for the right job’. In this case, ObjectARX, and by extension, Python, can provide a clean new drawing to import your DXFs into every time, whereas lisp may not. I don’t remember what all is stored in DXF, i.e. if there are things that are non-purgeable. An example is an existing text, dimension, or table style, that are named “Standard”. Nested references, Associated Styles (the text style for a dimension style). There may be user variables stored per drawing CLAYER, LTSCALE: So, using lisp DXFIN -> purge -> save on repeat may have subtle side effects. This may or may not be an issue for you1 point
-
I would maybe use: (vla-Offset (vlax-ename->vla-object ent) dist) where dist can be positive to go one direction, negative to go the other. This direction might also depend on the direction that the rectangle was drawn - clockwise or anticlockwise. Could do them both directions and just delete the shorter line - a few more lines of code to add though, some thinking for the first full week of work in 2026, always a quiet week. I might also suggest a couple more filters to the selection set, if all rectangles are closed polylines (test: 70 is 1 or 128 - use bitand (search for this Lee Mac uses this often to test both at the same time)), or number of vertices being 3 (closed polyline) or 4 (open polyline) (test: 90 is 3 or 4)1 point
-
According to the ARX docs using dxfIn While rlx’s version attempts to clean the drawing via vla-purgeall, I suppose there could be some items that are not purged? It’s not clear what happens in case of an existing dictionary or style. AI “AutoCAD typically handles conflicts by prioritizing the current drawing's definitions” I'm guessing that rlx’s version is safe enough though1 point
-
if you can use Python import traceback from pyrx import Ap, Db def convert_dxf_to_dwg(dxf: str): dwg = dxf.replace(".dxf", ".dwg") db = Db.Database(False, True) db.dxfIn(dxf) db.saveAs(dwg) @Ap.Command() def dxftodwg(): try: for dxf in Ap.Application.listFilesInPath("E:\\FloorPlans", ".dxf"): convert_dxf_to_dwg(dxf) except Exception as err: traceback.print_exception(err)1 point
-
new to Bricad but this seems to work : (defun c:DxfToDwg ( / actDoc dxf-folder dxf-list ) (setq actDoc (vla-get-activedocument (vlax-get-acad-object))) (vl-load-com) (cond ((not (setq dxf-folder (_getfolder "Select folder with dxf files"))) (princ "\nNo folder selected")) ((not (vl-consp (setq dxf-list (_getfiles dxf-folder "*.dxf")))) (princ (strcat "\nNo dxf files in folder " dxf-folder))) (t (command ".undo" "mark")(setvar "expert" 2) (foreach dxf dxf-list (command ".erase" "all" "") (vla-purgeall actDoc) (vl-cmdf "_.dxfin" dxf) (vla-ZoomExtents (vlax-get-acad-object)) (command ".save" (strcat (vl-filename-directory dxf) "\\" (vl-filename-base dxf))) ) (command ".undo" "back") ) ) (princ) ) ; generic getfolder routine with possibility to create a new subfolder (_getfolder "select path") (defun _getfolder ( m / f s) (if (and (setq s (vlax-create-object "Shell.Application")) (setq f (vlax-invoke s 'browseforfolder 0 m 65536 "")))(setq f (vlax-get-property (vlax-get-property f 'self) 'path)) (setq f nil))(vl-catch-all-apply 'vlax-release-object (list s)) (if f (vl-string-translate "\\" "/" f))) (defun void (x) (or (eq x nil) (and (listp x)(not (vl-consp x))) (and (eq 'STR (type x)) (eq "" (vl-string-trim " \t\r\n" x))))) (defun _getfiles ( fol ext / lst) (cond ((or (void fol) (not (vl-file-directory-p fol))) (princ (strcat "\nInvalid folder :" (vl-princ-to-string fol)))) (t (if (vl-consp (setq lst (vl-directory-files fol ext 1))) (setq lst (mapcar '(lambda (x)(strcat fol "/" x)) lst)))) ) lst )1 point
-
Lee's code allows the user to automatically generate polylines in modelspace representing the outline of a selected paperspace viewport, all viewports in the active paperspace layout, or all viewports found in all paperspace layouts. As long as the current layer is displayed in the Key Plan Viewport model space all those rectangles should display already. troggarf's code puts a copy of selected objects in paperspace.1 point
-
1 point
-
Most of the members here have real jobs as well and provide help as their own busy schedules allow. I do not believe anyone was being rude, just nudging you along to do a little work for yourself.1 point
-
1 point
-
1 point
