Leaderboard

Greetings to all members of Cad Tutor, Based on the upcoming holidays and New Year, I'v made something interesting which I want it to share with you. Everything was made using a Lisp. I hope it will interesting to all of you and maybe give some inspiration to the next year to made something different and share it with rest of us . Notice (it is on cyrillic, in Serbian language): - ЗИМСКА СЛУЖБА = Winter service on roads; - СРЕЋНА НОВА ГОДИНА = HAPPY NEW YEAR; - XO-XO-XOO = HO-HO-HOO (). Happy New Year 2026 to all members, and wish you all the best and new codes . NovaGodina2026_CadTutor.mp4 Best regards, Saxlle.

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:

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 0 0 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-vertex.lsp

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

Their IT department even has a slogan (and I'm not kidding here) : You name it , we block it

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.

@Danielm103 How can AI be better than human revision? Here is AI - I've added "red" color... (defun c:ortho_pline ( / orthogonalize-points edata ent newpts p pl pts x) (defun orthogonalize-points (pts / dx-in dx-out dy-in dy-out i in-is-h new-x new-y out-is-h p0 p1 p2 result) ;; If fewer than 3 points, nothing to do (if (< (length pts) 3) pts (progn (setq result pts) ;; Iterate interior vertices (setq i 1) (while (< i (- (length pts) 1)) (setq p0 (nth (- i 1) result)) (setq p1 (nth i result)) (setq p2 (nth (+ i 1) result)) ;; Incoming vector p0 -> p1 (setq dx-in (- (car p1) (car p0))) (setq dy-in (- (cadr p1) (cadr p0))) ;; Outgoing vector p1 -> p2 (setq dx-out (- (car p2) (car p1))) (setq dy-out (- (cadr p2) (cadr p1))) ;; Dominant direction tests (setq in-is-h (>= (abs dx-in) (abs dy-in))) (setq out-is-h (>= (abs dx-out) (abs dy-out))) ;; Case 1: Proper corner (one horizontal, one vertical) (cond ((/= in-is-h out-is-h) (if in-is-h (progn ;; incoming horizontal, outgoing vertical (setq new-x (car p2)) (setq new-y (cadr p0)) ) (progn ;; incoming vertical, outgoing horizontal (setq new-x (car p0)) (setq new-y (cadr p2)) ) ) ) ;; Case 2: both horizontal (in-is-h (setq new-x (car p1)) (setq new-y (cadr p0)) ) ;; Case 3: both vertical (t (setq new-x (car p0)) (setq new-y (cadr p1)) ) ) ;; Replace interior point (setq result (subst (list new-x new-y) p1 result)) (setq i (1+ i)) ) result ) ) ) (setq ent (car (entsel "\nSelect a polyline: "))) (if (not ent) (progn (princ "\nNothing selected.") (exit) ) ) (setq edata (entget ent)) ;; Ensure LWPOLYLINE (if (/= (cdr (assoc 0 edata)) "LWPOLYLINE") (progn (princ "\nEntity is not a lightweight polyline.") (exit) ) ) ;; Extract vertices (group code 10) (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) edata))) ;; Orthogonalize (setq newpts (orthogonalize-points pts)) ;; Create new polyline (setq pl (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length newpts)) '(70 . 0) ) (mapcar '(lambda (p) (cons 10 p)) newpts) (list '(62 . 1)) ) ) ) (if pl (princ "\nOrthogonal polyline created.") (princ "\nFailed to create polyline.") ) (princ) ) And here is my version - I used "green" color... (defun c:lw_orth ( / un f lw lwx pl ) (defun un ( l / a ll ) (while (setq a (car l)) (if (vl-some (function (lambda ( x ) (equal x a 1e-10))) l) (setq ll (cons a ll) l (vl-remove-if (function (lambda ( x ) (equal x a 1e-10))) (cdr l))) (setq ll (cons a ll) l (cdr l)) ) ) (reverse ll) ) (defun f ( l / i p1 p2 r ) (if (> (length l) 2) (progn (setq i -1) (while (< (setq i (1+ i)) (1- (length l))) (if (not p1) (setq p1 (nth i l) p2 (nth (1+ i) l)) (setq p1 p2 p2 (nth (1+ i) l)) ) (if (= i 0) (setq r (cons (car l) r)) ) (if (< (abs (- (car p2) (car p1))) (abs (- (cadr p2) (cadr p1)))) (setq r (cons (setq p2 (list (car p1) (cadr p2))) r)) (setq r (cons (setq p2 (list (car p2) (cadr p1))) r)) ) (if (= i (- (length l) 2)) (setq r (cons (last l) r)) ) ) (setq r (reverse r)) (un (apply (function append) (mapcar (function (lambda ( p1 p2 / pp ) (if (setq pp (vl-some (function (lambda ( x ) (if (and (equal (distance p1 p2) (+ (distance p1 x) (distance x p2)) 1e-10) (not (equal x p1 1e-10)) (not (equal x p2 1e-10))) x))) l)) (list p1 pp) (list p1)))) r (append (cdr r) (list (car r)))))) ) ) ) (if (and (setq lw (car (entsel "\nPick open polygonal lwpolyline to make its clone orthogonalized..."))) (= (cdr (assoc 0 (setq lwx (entget lw)))) "LWPOLYLINE") (or (= (cdr (assoc 70 lwx)) 0) (= (cdr (assoc 70 lwx)) 128)) (vl-every (function (lambda ( x ) (= (cdr x) 0.0))) (vl-remove-if (function (lambda ( x ) (/= (car x) 42))) lwx)) ) (progn (setq pl (mapcar (function (lambda ( p ) (trans p lw 1))) (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) lwx)))) (if (> (length pl) 2) (entmake (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length (setq pl (f pl)))) (cons 70 (* 128 (getvar (quote plinegen)))) (cons 38 0.0) ) (mapcar (function (lambda ( x ) (cons 10 x))) (mapcar (function (lambda ( p ) (trans p 1 lw))) pl)) (list (cons 62 3) (list 210 0.0 0.0 1.0) ) ) ) (prompt "\nPicked lwpolyline with insufficient number of vertices...") ) ) (prompt "\nMissed, or picked entity not open polygonal lwpolyline... Better luck next time...") ) (princ) ) In attached *.DWG you can see that AI version makes mistake with finalizing segment - it isn't always orthogonal... Anyway interesting and fun for coding... Regards, M.R. orthogonalize_lwpolyline.dwg

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

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

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! Clint

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”

Use this and simply switch: *dist* (- *dist*) To: (- *dist*) *dist*

@Danielm103 ""with mtext, you have to use a fixed width font" I agree, Monotxt.sHx I think was what I used. monotxt_.ttf EXTRA FONTS A-Z.txt Banner heading3.lsp

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)

A slightly blunter method I use is to line everything up to a grid spacing (in my LISP I define the spacing rather than the drawing.... just in case) which usually works OK for most thing. A lot of what I do is line diagrams and the polylines are never too far out. - Get a list of points, use Lee Macs round to closest on each point, entmod the line using original and new points. I'd prefer entmod than making a new line just in case something goes wrong in between deleting the original and creating the new, retains all the original polyline info.

Another example. This allows you to select a closed polyline and hatch it by aligning itself to the side of the selection point. (vl-load-com) (defun c:hatch_align_vtx ( / AcDoc flag *error* f_pat ent Space pr-1 pr-1 alpha hatch) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) flag T) (vla-StartUndoMark AcDoc) (defun *error* (msg) (and msg (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*")) (princ (strcat "\nError: " msg)) ) (if (= 8 (logand (getvar "UNDOCTL") 8)) (vla-endundomark AcDoc) ) (princ) ) (if (not (findfile "BAT_PUBL.pat")) (progn (setq f_pat (open (strcat (getvar "ROAMABLEROOTPREFIX") "support\\BAT_PUBL.pat") "w")) (write-line "*BAT_PUBL" f_pat) (write-line "45,0,0,0,.75" f_pat) (write-line "315,0,0,0,.75" f_pat) (close f_pat) ) ) (while (setq ent (entsel "\nSelect the long side polyline to hatch it: ")) (setq obj_curv (vlax-ename->vla-object (car ent))) (cond ((and (eq (vlax-get-property obj_curv 'ObjectName) "AcDbPolyline") (eq (vla-get-closed obj_curv) :vlax-true) ) (setq Space (if (eq (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) pr-1 (fix (vlax-curve-getParamAtPoint obj_curv (vlax-curve-getClosestPointTo obj_curv (cadr ent) nil))) pr+1 (if (>= (1+ pr-1) (fix (vlax-curve-getEndParam obj_curv))) 0 (1+ pr-1)) alpha (+ (angle (vlax-curve-getPointAtParam obj_curv pr-1) (vlax-curve-getPointAtParam obj_curv pr+1)) (* 0.25 pi)) ) (setq hatch (vla-AddHatch Space acHatchPatternTypeCustomDefined "BAT_PUBL" :vlax-True)) (vlax-invoke hatch 'AppendOuterLoop (list obj_curv)) (vla-put-patternscale hatch 1.0) (vla-put-patternangle hatch alpha) (vla-evaluate hatch) ) ) ) (*error* nil) (vla-EndUndoMark AcDoc) (prin1) )

Select at start of what you need, then shift select the end is fastest I know (you can actually go from end to the beginning as well).

somehow a document type object lives along your copied_objects so try this : (defun c:new_desktop_file_copy ( / acad_dbx object_list zero_point db) (defun make_color_21 (/ layers) (setq layers (vla-get-layers acad_dbx)) (vlax-map-collection (vla-get-blocks acad_dbx) '(lambda (block) (vlax-map-collection block '(lambda (object) (vla-put-color object 256) (if (/= 21 (vla-get-color (setq layer (vla-item layers (vla-get-layer object))))) (vla-put-color layer 21)))) ) ) ) (setq acad_dbx (vla-getinterfaceobject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." (substr (getvar 'acadver) 1 2)))) (prompt "\nPick objects to copy to a new file on the desktop...") (setq object_list (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget)))))) (setq zero_point (getpoint "\nPick zero point for the copied entities: ")) (setq db (vla-get-database (vla-get-activedocument (vlax-get-acad-object)))) (foreach copied_object (setq odbx_objects_list (vlax-invoke db 'copyobjects object_list (vla-get-modelspace acad_dbx))) (if (vlax-method-applicable-p copied_object 'move) (vla-move copied_object (vlax-3d-point zero_point) (vlax-3d-point 0 0 0)) (princ (strcat "\nUnable to move object name : " (vla-get-name copied_object))) ) ) (make_color_21) (vla-saveas acad_dbx (princ (strcat (getenv "userprofile") "\\Desktop\\" (getstring "\nEnter file name: ") ".dwg"))) (vlax-release-object acad_dbx) (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 )

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.

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

Just use: (command "_.OFFSET" dist ent "_non" offsetpt "") And you no longer need to worry about OSMODE.

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.

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

I tested the code on your drawing and it works correctly. Perhaps you didn't use it correctly. Nikon1.mp4

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.

There's an app for that: https://apps.autodesk.com/ACD/en/Detail/Index?id=3434696327413675915&appLang=en&os=Win32_64

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 )

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.

I have done something like this a couple of years ago :

with mtext, you have to use a fixed width font import traceback from pyrx import Ap, Db, Ed import art @Ap.Command() def doit(): try: db = Db.curDb() mt = Db.MText() mt.setDatabaseDefaults() val = art.text2art("Sup Dude!", font="big", sep ="\\P") mt.setContents("{\\Fmonotxt8|c0;" + val + "}") db.addToModelspace(mt) except Exception as err: traceback.print_exception(err)

I have to agree with Bigal about to (new)bee or not to (new)bee but to give you an idea ; (setq val (getentitytransparency (car (entsel)))) (defun getentitytransparency ( ent ) (cond ((= 'vla-object (type ent))(vla-get-entitytransparency ent)) ((= 'ename (type ent))(getentitytransparency (vlax-ename->vla-object ent))))) ; (< lower-limit test-number upper-limit) ; (putentitytransparency (car (entsel)) "ByBlock") (putentitytransparency (car (entsel)) 100) (defun putentitytransparency (e v / i o) (cond ((null v)(setq v "ByLayer"))((and (numberp v)(< 0 v 90))(setq v (itoa (fix v)))) ((and (= (type v) 'STR) (distof v) (>= 0 (setq i (fix (distof v))) 90))(setq v (itoa i))) ((and (= (type v) 'STR) (member (strcase v t)'("bylayer" "byblock"))) v)(t (setq v "0"))) (if (setq o (e->o e))(vla-put-entitytransparency o v)))

@mhupp do you want a lisp version of that ? It works same way uses "*". I think it was 1990.s used it as header in lisp programs.

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,

Some really cool stuff here

test with wxPython

Attempt number 2: This code is intended to always return a centerline whose points are all perfectly equidistant from the margins. This should happen in all cases where two LWPOLYLINEs are provided, one for each margin. The case of islands has not been considered yet. The resulting centerline is geometrically dense. This can probably be simplified in a future version. The approach taken in this code has been to obtain points from the normals and the bisectors of each margin, which are then combined at the end to build a list of points. Therefore, it is a fragmentary and massive approach. For this reason, the code is not very fast. However, there is another, more elegant approach, based on dynamically relating the geometry of both margins. It is more complex, but it would also be faster, and the error margins would be “bridgable”. If this thread has enough life in it, I may feel sufficiently motivated to finish it. That’s all for now. ;|*********************** CENTER-LINE ************************* ************************ G L A V C V S ************************* ************************** F E C I T *************************** |; (defun c:CLG (/ PI/2 lst e1 e2 l1 l2 lp lp1 lp2 p0 p> p< r1? x m a tol autoInt? ordenaPts interCpta ptEqd) (defun autoInt? (l lp / p0 p1 p2);autointersecci贸n? (if l (setq p1 (polar (car l) (setq a (angle (car l) (cadr l))) 0.001) p2 (polar (cadr l) (+ a PI) 0.001) x (if (not (vl-some '(lambda (p) (if p0 (inters p0 (setq p0 p) p1 p2) (not (setq p0 p)))) lp)) l) ) ) ) (defun ordenaPts (lst / pIni dm d ps? ps lr); puntos en orden (setq pIni (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (car lp1) (car lp2))) (while lst (foreach p lst (if (and dm (/= (min (setq d (distance (if ps ps pIni) p)) dm) dm)) (setq dm d ps? p) (if (not dm) (setq dm (distance (if ps ps pIni) p) ps? p)) ) ) (setq ps ps? ps? nil dm nil lst (vl-remove ps lst) lr (cons (cadr ps) (cons (car ps) lr))) ) lr ) (defun interCpta (pM p1 p2 lp / i? i1 i2 d a b); captura de los m谩rgenes (defun i? (pA pB lp / p0 i dm is a) (foreach p lp (if p0 (if (setq i (inters p0 (setq p0 p) pA pB)) (if (and dm (/= (min (setq d (distance pM i)) dm) dm)) (setq dm d is i) (if (not dm) (setq dm (distance pm i) is i)) ) ) ) (setq p0 p) ) (if is (list (car is) (cadr is) 0.0)) ) (if (and (setq a (i? p1 p2 lp1)) (setq b (i? p1 p2 lp2))) (list a b) ) ) (defun ptEqd (A B e1 e2 / eqDist-f t0 t1 f0 f1 tm fm n i v+- v*); captura punto equidistante (defun v+- (o a b) (mapcar o a b)) (defun v* (p s) (mapcar '(lambda (x) (* x s)) p)) (defun eqDist-f (ds A B e1 e2 / pt d1 d2) (setq pt (v+- '+ A (v* (v+- '- B A) ds)); Punto sobre AB: P(ds) = A + ds (B - A) d1 (distance pt (vlax-curve-getClosestPointTo e1 pt)) d2 (distance pt (vlax-curve-getClosestPointTo e2 pt)) ) (- d1 d2) ) (setq t0 0.0 t1 1.0) (while (and (< (setq n (if n (1+ n) 0)) 100) (> (- t1 t0) 1e-6));m茅todo de bisecci贸n (setq tm (/ (+ t0 t1) 2.0) fm (eqDist-f tm A B e1 e2) ) (if (< (abs fm) 1e-9) (setq n 100 t1 tm t0 tm) (if (< (* (if f0 f0 (eqDist-f t0 A B e1 e2)) fm) 0.0) (setq t1 tm f1 fm) (setq t0 tm f0 fm) ) ) ) (if (< t1 1.0) ; par谩metro final y punto equidistante (v+- '+ A (v* (v+- '- B A) (/ (+ t0 t1) 2.0))) ) ) (if (and (setq e1 (car (entsel "\nSelect FIRST LWPolyline..."))) (= (cdr (assoc 0 (setq l1 (entget e1)))) "LWPOLYLINE") ) (if (and (setq e2 (car (entsel "\nSelect SECOND LWPolyline..."))) (= (cdr (assoc 0 (setq l2 (entget e2)))) "LWPOLYLINE") ) (progn (foreach l l1 (if (= (car l) 10) (setq lp1 (cons (cdr l) lp1)))) (foreach l l2 (if (= (car l) 10) (setq lp2 (cons (cdr l) lp2)))) (setq r1? (> (distance (car lp1) (car lp2)) (distance (car lp1) (last lp2)))) (setq tol 0.01 PI/2 (/ PI 2.) lp1 (if r1? (reverse lp1) lp1)) (foreach e (list e1 e2) (setq p0 nil m nil r? (if (equal e e1) r1?) lp (if (equal e e1) lp2 lp1)) (while (setq p (vlax-curve-getPointAtParam e (setq m (if m ((if r? 1- 1+) m) (if r? (vlax-curve-getEndParam e) 0))))) (if p0 (progn (setq lAB (autoInt? (interCpta p (polar p (setq a (+ (angle p0 p) PI/2)) 10000) (polar p (+ a PI) 10000) lp) (if (equal e e1) lp1 lp2));NORMAL AL COMIENZO DEL SEGMENTO lst (if lAB (cons (ptEqd (car lAB) (cadr lAB) e1 e2) lst) lst) ) (if (setq p> (vlax-curve-getPointAtParam e ((if r? 1- 1+) m))) (setq lAB (autoInt? (interCpta p (polar p (setq a (/ (+ (angle p p0) (angle p p>)) 2.)) 10000) (polar p (+ a PI) 10000) lp) (if (equal e e1) lp1 lp2)) ; Bisectriz lst (if lAB (cons (ptEqd (car lAB) (cadr lAB) e1 e2) lst) lst) lAB (autoInt? (interCpta p (polar p (setq a (+ (angle p p>) PI/2)) 10000) (polar p (+ a PI) 10000) lp) (if (equal e e1) lp1 lp2));NORMAL AL FINAL DEL SEGMENTO lst (if lAB (cons (ptEqd (car lAB) (cadr lAB) e1 e2) lst) lst) ) ) (setq p< p0 p0 p) ) (if (setq p> (vlax-curve-getPointAtParam e ((if r? 1- 1+) m))) (setq lAB (autoInt? (interCpta p (polar (setq p0 p) (setq a (+ (angle p0 p>) PI/2)) 10000) (polar p0 (+ a PI) 10000) lp) (if (equal e e1) lp1 lp2)) lst (if lAB (cons (ptEqd (car lAB) (cadr lAB) e1 e2) lst) lst) ) ) ) ) ) (vla-AddLightWeightPolyline (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-Make-Variant (vlax-SafeArray-Fill (vlax-Make-SafeArray 5 (cons 0 (- (length (setq lst (reverse (ordenaPts lst)))) 1))) lst)) ) ) ) ) (princ) )

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 ?

I know this is an old thread but here it is my fifty cents attempt, I was looking for a created solution but had to complete it, thanks to all ;;; By Isaac A. 20251219 ;;; https://www.cadtutor.net/forum/topic/73414-select-all-points-on-polyline/ ;;; Point on Polyline 'ptopl' (vl-load-com) (defun c:ptopl (/ a b c d dw l oc os) (vla-startundomark (setq dw (vla-get-activedocument (vlax-get-acad-object)))) (setq oc (getvar 'cmdecho) os (getvar 'osmode) ) (setvar 'cmdecho 0) (setvar 'osmode 0) (princ "\nSelect the polylines that touch the points") (setq l (ssget (list (cons 0 "LWPOLYLINE")))) (if l (progn (setq a 0 ) (while (< a (sslength l)) (setq b (entget (ssname l a)) c (append c (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) b))) a (1+ a) ) (setq d (ssget "F" c (list (cons 0 "Point")))) (sssetfirst nil d) ) ) (princ "\nThere are no selected polylines") ) (setvar 'cmdecho oc) (setvar 'osmode os) (vla-endundomark dw) (princ) ) ;;; End ptopl

I am like others as suggested dont use a command word, as your wanting to use a defun then why not just call the defun something shorter, like CENTL.You can use AUTOLOAD to load the actual lisp at the first time you type centl. You would put the "Autoload" in say a custom lisp that is loaded on startup, along with your other AUTOLOAD's (autoload "CENTL" '("CENTL")) (autoload "COPY0" '("COPY0")) (autoload "COPYCOMMAND" '("ZZZ")) (autoload "COVER" '("COVER"))