Leaderboard

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:

A start with this? (vl-load-com) (defun c:label_bearing ( / l_var AcDoc Space nw_style nw_obj dxf_text pt1 pt2 dxf_line key pt alpha len_l m_pt val_txt) (setq l_var (mapcar 'getvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS" "TEXTSIZE"))) (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS") (list 0 1 (* pi 0.5) 4 3 2 2)) (setvar "TEXTSIZE" (* (getvar "VIEWSIZE") 0.015)) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (vla-startundomark AcDoc) (cond ((null (tblsearch "STYLE" "BEARING")) (setq nw_style (vla-add (vla-get-textstyles AcDoc) "BEARING")) (mapcar '(lambda (pr val) (vlax-put nw_style pr val) ) (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag) (list "romand.shx" 0.0 0.0 1.0 0.0) ) ) ) (setq nw_obj (vla-addMtext Space (vlax-3d-point '(0.0 0.0 0.0)) 0.0 "" ) dxf_text (entget (entlast)) ) (initget 1) (setq pt1 (getpoint "\nPick base point: ") pt2 pt1 ) (entmake (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt2))) (setq dxf_line (entget (entlast))) (while (equal pt2 pt1) (setq pt2 ((lambda ( / key pt alpha len_l m_pt) (princ "\nPick other point: ") (while (and (setq key (grread T 4 0)) (/= (car key) 3)) (cond ((eq (car key) 5) (redraw) (setq pt (cadr key) alpha (angle pt1 pt) len_l (distance pt1 pt) m_pt (mapcar '* (mapcar '+ pt1 pt) '(0.5 0.5 0.5)) val_txt (vl-string-subst "%%d" "d" (strcat (angtos alpha) "\\P " (rtos len_l) " m")) dxf_line (entmod (subst (cons 11 pt) (assoc 11 dxf_line) dxf_line ) ) ) (if (and (> alpha (* pi 0.5)) (<= alpha (* pi 1.5))) (setq alpha (+ alpha pi)) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation 'TextString 'Color) (list 5 (getvar "TEXTSIZE") 5 m_pt "BEARING" (getvar "CLAYER") alpha val_txt 2) ) (entmod (subst (cons 50 alpha) (assoc 50 dxf_text) (subst (cons 10 (polar m_pt (+ alpha (* pi 0.5)) (getvar "TEXTSIZE"))) (assoc 10 dxf_text) dxf_txt) ) ) ) ) ) (cadr key) )) ) ) (vla-endundomark AcDoc) (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS" "TEXTSIZE") l_var) (prin1) )

I don't really see the point of the dynamic mode in your function, especially if you want to snap to objects. This would seem to me to be sufficient and would resolve the osnap. (vl-load-com) (defun c:label_bearing ( / l_var AcDoc Space nw_style nw_obj pt1 pt alpha len_l m_pt val_txt) (setq l_var (mapcar 'getvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS" "TEXTSIZE"))) (initget "Bearing Degrees") (if (eq (getkword "\nResult in [Bearing/Degrees]?<Bearing>: ") "Degrees") (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS") (list 0 1 (* pi 1.5) 1 3 2 2)) (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS") (list 0 1 (* pi 0.5) 4 3 2 2)) ) (setvar "TEXTSIZE" (* (getvar "VIEWSIZE") 0.015)) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (vla-startundomark AcDoc) (cond ((null (tblsearch "STYLE" "BEARING")) (setq nw_style (vla-add (vla-get-textstyles AcDoc) "BEARING")) (mapcar '(lambda (pr val) (vlax-put nw_style pr val) ) (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag) (list "romand.shx" 0.0 0.0 1.0 0.0) ) ) ) (setq nw_obj (vla-addMtext Space (vlax-3d-point '(0.0 0.0 0.0)) 0.0 "" ) ) (initget 1) (setq pt1 (getpoint "\nPick base point: ")) (initget 1) (setq pt (getpoint pt1 "\nPick other point: ")) (entmake (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt))) (setq alpha (angle pt1 pt) len_l (distance pt1 pt) m_pt (mapcar '* (mapcar '+ pt1 pt) '(0.5 0.5 0.5)) val_txt (vl-string-subst "%%d" "d" (strcat (angtos alpha) "\\P " (rtos len_l) " m")) ) (if (and (> alpha (* pi 0.5)) (<= alpha (* pi 1.5))) (setq alpha (+ alpha pi)) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation 'TextString 'Color) (list 5 (getvar "TEXTSIZE") 5 m_pt "BEARING" (getvar "CLAYER") alpha val_txt 2) ) (vla-endundomark AcDoc) (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS" "TEXTSIZE") l_var) (prin1) ) However, if you absolutely want the dynamic mode with the possibility of osnap, here is the redesigned function attached. ("osmode" must be defined beforehand, no possibility to force it when using the function) My management is succinct: only: "_end" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea" For a more elaborate management see perhaps the LeeMac function label_bearing.lsp

I wasn't talking about the code

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) )

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 )

I have a dump LISP called TakeADump, maybe I need this to go along with it!

I relied on your pictures... ??? In your picture: I see for degrees: Deg/Min/Sec - Clockwise (on) - South 90d0' If not correct change ANGDIR, ANGBASE and AUNITS in: (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS") (list 0 1 (* pi 1.5) 1 3 2 2))

Must have deleted from my other post, But how grread works I don't know if you can use snaps. every time you move the mouse it updates the point and calculation. maybe Tsuky knows of a way.

The question was AutoCAD and was 12 years ago. To add, not much help just stating a program has a feature without any other context. Though there is the ability to adjust linetypes in MicroStation, the usual remedy is to break the line in most cases, same as AutoCAD.

Needs work, just an example from pyrx import Ap, Db, Ed, Ge, Gi import math print("command = yeehaw") class NavJig(Ed.DrawJig): def __init__(self, basepoint): Ed.DrawJig.__init__(self) self.ds = Ed.DragStatus.kNormal self.basepoint = basepoint self.curpoint = basepoint self.mt = Db.MText() self.mt.setDatabaseDefaults() self.mt.setAttachment(Db.MTextAttachmentPoint.kMiddleLeft) def get_vector_details(self, vector: Ge.Vector3d): v_length = vector.length() azimuth_rad = math.atan2(vector.x, vector.y) azimuth_deg = math.degrees(azimuth_rad) % 360 if 0 <= azimuth_deg <= 90: bearing = f"N {azimuth_deg:.2f} E" elif 90 < azimuth_deg <= 180: bearing = f"S {180 - azimuth_deg:.2f} E" elif 180 < azimuth_deg <= 270: bearing = f"S {azimuth_deg - 180:.2f} W" else: bearing = f"N {360 - azimuth_deg:.2f} W" return f"Length: {v_length:.4f}\\P" f"{azimuth_deg:.2f}%%d " f"{bearing}" def sampler(self): self.setUserInputControls(Ed.UserInputControls.kAccept3dCoordinates) self.ds, self.curpoint = self.acquirePoint() return self.ds def update(self): if self.ds == Ed.DragStatus.kNoChange: return False return True def worldDraw(self, wd: Gi.WorldDraw): if self.ds == Ed.DragStatus.kNoChange: return True try: geo = wd.geometry() v = self.curpoint - self.basepoint self.mt.setContents(self.get_vector_details(v)) self.mt.setLocation(self.basepoint + (v * 0.5)) self.mt.setDirection(v) geo.draw(self.mt) geo.polyline([self.basepoint, self.curpoint], Ge.Vector3d.kZAxis) return True except Exception as err: print(err) @Ap.Command() def yeehaw(): try: jig = NavJig(Ge.Point3d(0, 0, 0)) jig.setDispPrompt("\nPick point:\n") res = jig.drag() print("done", res) except Exception as err: print(err)

Have you looked into fields? When you edit a text object, you can type Ctrl-F to bring up the fields dialog. Pick a category, such as Date & Time, and pick the data you want to insert. To match your example, choose Date and a format. That field will be inserted into the text, like any other characters, but highlighted and with the corresponding data. There are many more pieces of data you can use. Once you put fields into your template, you may never have to change a title block again.

Hi, some years have passed but still thank you for the solution! I combined this lisp to another i had so now it sets everything inside the block to "ByBlock" Layer → 0 Color → ByBlock Linetype → ByBlock Lineweight → ByBlock Transparency → ByBlock Thanks again! (defun NestedPutProp (nme prop val / blk) (if (and (not (vl-catch-all-error-p (setq blk (vl-catch-all-apply 'vla-item (list (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)) ) nme ) ) ) ) ) (= :vlax-false (vla-get-islayout blk)) (= :vlax-false (vla-get-isxref blk)) ) (vlax-for obj blk (vlax-put obj prop val) ) ) ) (defun KGA_Conv_Pickset_To_ObjectList (ss / i ret) (if ss (repeat (setq i (sslength ss)) (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret ) ) ) ) ) (defun c:setbyblock ( / adoc ss doneLst) (vl-load-com) (setq adoc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark adoc) (if (setq ss (ssget '((0 . "INSERT")))) (foreach obj (KGA_Conv_Pickset_To_ObjectList ss) (if (not (vl-position (strcase (vla-get-name obj)) doneLst)) (progn ;; Set standard ByBlock properties (NestedPutProp (vla-get-name obj) 'Layer "0") (NestedPutProp (vla-get-name obj) 'Color 0) (NestedPutProp (vla-get-name obj) 'Linetype "BYBLOCK") (NestedPutProp (vla-get-name obj) 'Lineweight acLnWtByBlock) (NestedPutProp (vla-get-name obj) 'EntityTransparency "BYBLOCK") (setq doneLst (cons (strcase (vla-get-name obj)) doneLst)) ) ) ) ) (vla-regen adoc acallviewports) (vla-endundomark adoc) (princ) )

Hehe reminds me of when I made a shortcut command for one of our customs lisp "Assembly populate".

Thanx Steven , for wiping mine...

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: ") )

to update entmod you need to get familiar with dxf codes. This simple lisps will dump to the command line. All entities follow a pattern. ;;----------------------------------------------------------------------------;; ;; Dump all DXF Group Data (defun C:DumpIt (/ ent) (while (setq ent (car (entsel "\nSelect Entity to Dump"))) (mapcar 'print (entget ent '( "*"))) ) (princ) ) ;;----------------------------------------------------------------------------;; ;; Dump All Visual Lisp Methods and Properties for Selected Entity (defun C:VDumpIt (/ ent) (while (setq ent (car (entsel "\nSelect Entity to Dump"))) (vlax-Dump-Object (vlax-Ename->Vla-Object ent) t) ) (princ) ) entsel will return an entity name and point of seleciton. use that to see which endpoint your closest to. and use that to update with entmod and entupd. ;;----------------------------------------------------------------------------;; ;; Extend line to new point. ;; https://www.cadtutor.net/forum/topic/98936-change-a-length-of-line-by-feeding-a-new-end-point-to-the-association-list/ (defun c:EXTLINE ( / sel ent pick line sp ep newpt) (if (setq sel (entsel "\nSelect line near the end to extend: ")) (progn (setq ent (car sel) pt (cadr sel) line (entget ent) ) (if (= (cdr (assoc 0 line)) "LINE") (progn (setq sp (cdr (assoc 10 line))) (setq ep (cdr (assoc 11 line))) (if (< (distance pt sp) (distance pt ep)) (setq newpt (getpoint ep "\nSpecify new endpoint: ") line (subst (cons 10 newpt) (assoc 10 line) line) ) (setq newpt (getpoint sp "\nSpecify new endpoint: ") line (subst (cons 11 newpt) (assoc 11 line) line) ) ) (entmod line) (entupd ent) ) (prompt "\nSelected entity is not a LINE.") ) ) ) (princ) )

My first comment is when you hard print the pdf you have to pick a paper size so why would you not just pick a paper size to start with ? I do not understand the Custom scale size needed. In the world you are normally metric or imperial paper sizes. You can easily with a lisp etc plot a standard sheet size in a layout that has a Viewport at the correct scale. I think that is the step your not understanding, many example code does exist. For me a couple of choices make multiple layouts at scale walking along a pline, make multiple rectangs in Model at a scale matching viewports and title blocks in layouts. In this image select a title block and scale pick on Model and correct layout is made. A rectang is drawn in the model showing the result so you can accept or erase and run again. You can move and rotate the rectang before making the matching layout.

See the links in this post for information on using snaps with grread. (The entire thread is a good read)

You should use the Plot Stamp to add the plotted/printed date, the date on the drawing should always remain the same, each revision gets a date as well and also should remain the same throughout the history of the drawing.

I should have used acdbAngToS which honors AUNITS

Just a comment over at Autodesk forum I posted some code to plot all dwg's in a certain directory to one pdf using publish. It has a bug though if the dwg's do not have the correct page setup saved, they don't plot. It uses OBDX to make the page setup but that is the point where I have a problem, setting the pagesetup to a known saved name. Still working on it. Using a script may be easier for the moment as can plot the pdf for each dwg then use via lisp Ghostscript to join them back into one. The only downfall is the script will open every dwg to process. I have the code for layouts into one pdf so will look at using a script in that code. The post at Autodesk wants only Model space plotted. The pdf's are located in a \PDF directory under the current dwg directory.

Nice idea, here in Aus the brg is 0-360 dddmmss, much easier than the S & E etc. Maybe be second version.

BigAl loves his scripts and I suspect has one to copy and paste in here... though if you search this forum as well there are plenty of pdf and batch examples, just need to put them together. I have a PDF LISP (type in "plotPDF" and it creates a PDF in the drawings folder). Regardless what you are doing, typing 7 characters is a lot faster than the menu for PDF, select save folder and so on - so well worth finding one of these on the internet. As a side comment here set up a separate plotter for PDFs without the 'preview' check box - makes things better. The essence of the batch process is to create a script, saved as for example "MyScript.scr" (remember to set the file type to *.* so it saves right as a scr) Here is an example, copy, paste and change for each file you want to plot _.OPEN "YOUR_FILE_PATH_AND_FILE_NAME.dwg";;OPens the file (load "YOUR_PLOTTING_LISP_FILE_PATH_AND_FILE_NAME.lsp");;Loads the LISP (setvar "ctab" (nth 0 (layoutlist)));;Go to layout '0' (first layout in the layout list) (YOURPDFPLOTTINGLISP) (OR 'YOURPDFPLOTTINGLISP' );;do the plotting (if (= dbmod 0) (command ".close"));;if file not modified close (if (/= dbmod 0)(command ".close" "y"));;if file modified close and "OK to cancel changes" Then in a CAD file run the script We should one day find the time to make this nice, user friendly and a sticky thread the number of times this gets asked over the years... one day...

going to use grread and mouse pointer. maybe edit Demo2?

Thanks... I think I've narrowed it down to an addon downloaded from the Autodesk Exchange Apps site. As soon as I unload it, everything is back to normal. Looks like a minor bug in the addon. Thanks for all your suggestions!

Another, could do a pop enter value in a dcl box etc, rather than command line. It works to specified length. (defun C:test2 ( / p1 p2 dist d) (initget 1) (setq p1 (getpoint "\npick point 1")) (initget 1) (setq p2 (getpoint p1 "\npick point 2")) (setq dist (distance p1 p2)) (setq d (getreal (strcat "\nLine length is " (rtos dist 2 2) " Enter new length "))) (if (= d nil) (princ) (setq dist d) ) (setq p2 (polar p1 (angle p1 p2) dist)) (command "_.line""_non" p1 "_non" p2 "") (princ) ) (c:test2)

Maybe with this subterfuge? (defun c:foo ( / src dxf app doc scr old new) (while (progn (setvar 'errno 0) (setq src (car (entsel (strcat "\nSelect block reference: ")))) (cond ((= 7 (getvar 'errno)) (princ "\nMissed, try again.") ) ((= 'ename (type src)) (setq dxf (entget src)) (cond ((/= "INSERT" (cdr (assoc 0 dxf))) (princ "\nPlease select a block reference.") ) ((= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 dxf))))))) (princ "\nSelected block is on a locked layer.") ) ) ) ) ) ) (if (= 'ename (type src)) (progn (setq app (vlax-get-acad-object) doc (vla-get-activedocument app) src (vlax-ename->vla-object src) old (vlax-get-property src (if (vlax-property-available-p src 'effectivename) 'effectivename 'name)) new (strcat old (getstring t (strcat "\nSpecify new block name <" old ">: " (princ (strcat "\n" old))))) ) (cond ((and (= "" new) (or (not (snvalid new)) (tblsearch "block" new)) ) (princ "\nBlock name invalid or already exists.") ) (T (command "_.rename" "_block" old new)) ) ) ) (prin1) )

Use (list (entlast) p2) at place of p2: (list (entlast) p2) <=> at return of (entsel) (defun C:test1 ( / p1 p2 line1) (initget 1) (setq p1 (getpoint "\npick point1")) (initget 1) (setq p2 (getpoint p1 "\npick point2")) (command "_.line""_non" p1 "_non" p2 "") (setq line1 (entlast)) (command "_.lengthen" "_DYnamic" (list line1 p2) pause "") (command "_.change" line1 "" "_Properties" "_Color" "1" "") (prin1) )

Maybe it is possible to change the order of commands, at first "change", then "lengthen" ? (defun C:LineChLenDY ( / p1 p2 line1) (setq p1 (getpoint "Specify the first point: ")) (setq p2 (getpoint "Specify the second point: ")) (command "line" "non" p1 "non" p2 "") (setq line1 (entlast)) (command "change" line1 "" "P" "C" "1" "") (command "lengthen" "DYnamic") (princ) )

Not so sure you can do 'end' with the keyboard with the standard (getstring) functions - either live with it or perhaps a DCL pop up might let you do this. Should be able to amend Lees Code to insert a dialogue if it really is necessary. Change this line to call another function with the code needed, return value will be the string that (setq new is looking for: (setq new (strcat (getstring t (strcat "\nPrefix For Block <" def ">: ")) " " old)))

I don't think I have used lengthen in a LISP, not used the command for a while, but a quick look at your code "non"p2) - add a couple of spaces for readbility, but in that line you haven't specified the line to lengthen and you might need to end with "": (command "_lengthen" "DYnamic" "non" p2 (entlast) "")

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.

Ahh, was that yours RX? Mega apologies - I thought I had taken Lees from earlier in that thread (For this thread, RLX also had some ace code in the thread I linked to above)

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.

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) ))

Yes, even though I'm only using basic Arial font I did test with Simplex as well and still have the same problem. Example DWG attached, although I'm certain it's not a drawing-specific issue, as the problem now occurs on any old drawings that I open X.dwg

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.

ssget lines check endpoints to get angle tho not so vertical. vert.mp4 SVL.lsp

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, Ryan

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 lol

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'.

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) )

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”

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.

I post the 3d house image often and a version of that software was available for Intellicad back in the 90's, there was no VL lisp in those days. It was very good then and seen as a competitor to LT,

I use a template with all my setups, then command "PSETUPIN" to import. If you want to use lisp to add one it's as simple as this: (vla-add (vla-get-PlotConfigurations (vla-get-ActiveDocument (vlax-get-acad-object)))"TEST") But then you also have to set the appropriate properties ... IMO it's much easier to use a template.

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)