All Activity

I think I have a ready for testing version ready. If I have time I'll try it on AutoCAD 2000i on my home computer as well. Let me know if you have issues, I tested it in a few cases on AutoCAD 2026. I still have a few things I want to add to it for myself, maybe some reactors for the CrossHairs, I might add a DCL for the Layer information, et. al. ;;; Add AutoCAD's Native CENTERMARK (option for a CrossHair of lines) to Diameter/Radius dimension and turns off the Center Mark/Line if on. ;;; ;;; https://www.cadtutor.net/forum/topic/99350-center-mark-replacement/#findComment-680408 ;;; ;;; By SLW210 (a.k.a. Steve Wilson) ;;; ;;; Since AutoCAD in there infinite wisdom makes the default dimdia and dimrad center marks useless ;;; by not allowing them to be associated by other dimensions and not allowing an individual color and linetype. ;;; I came up with this little routine. Much faster, it was using some commands, I went to removing commands. Though ;;; for CENTERMARK, a command is needed so there remains those that are necessary. ;;; I used to get rid of the default then drew a centermark and copied from center to center, a bit tedious at best. ;;; ;;; I started with this from Alan J Thompson, so thanks to him. ;;; ================================================================ ;;; Turn off the centermark for diameter and radius dimensions ;;; ;;; https://www.cadtutor.net/forum/topic/18792-request-routint-to-turn-off-center-mark-for-single-entity/#findComment-153451 ;;; ;;; By alanjt|; ;;; ;;; ================================================================ ;;; ================================================================ ;;; AddCtrMrk.lsp ;;; ;;; ;;; AutoCAD 2018-2026 should work as well as BricsCAD and others. ;;; Even if there is not a CENTERMARK command, it should use the CrossHair fallback. ;;; ;;; ================================================================ ;;; ================================================================ ;;; Original dimensions are retained. ;;; ;;; Replacement geometry: ;;; Layer : CenterMark ;;; Color : ByLayer ;;; Linetype : ByLayer ;;; Layer Color : ACI 5 (Blue) ;;; Layer Linetype : ByLayer ;;; ;;; Options: ;;; Native -uses AutoCAD's (or other) native CENTERMARK command (if available) ;;; Crosshair -uses the inbuilt CrossHair made of lines and automatically sized to the curve object ;;; Auto -Automatically selects native CENTERMARK if available or uses CrossHair if not available ;;; ;;; Modes: ;;; Select - manually selected DIMDIAMETER/DIMRADIUS (This LISP works on the dimension not the Arc, Circle, etc., so select the dimension) ;;; Current - all such dimensions in current Model/Layout space ;;; All - all such dimensions in all paperspace layouts + Model ;;; ;;; Associated dimension center marks: ;;; Disabled using acCenterNone. ;;; ;;; Duplicate centers: ;;; Only one Centermark or CrossHair is created for each unique center ;;; within each Model/Layout space using a center tolerance. ;;; ================================================================ (vl-load-com) (setq *ACM-CENTER-TOL* 0.01) (setq *ACM-NATIVE-COUNT* 0) (setq *ACM-CROSSHAIR-COUNT* 0) ;; Mark style selected when ACM runs: Native, Crosshair, or Auto. ;; Auto tries CENTERMARK first and falls back to manual crosshairs. (setq *ACM-MARK-STYLE* "Auto") ;;; ============================================================ ;;; ENSURE CENTERMARK LAYER ;;; ============================================================ (defun ACM:EnsureLayer (/ appObj doc layers lay) (setq appObj (vlax-get-acad-object)) (setq doc (vla-get-ActiveDocument appObj)) (setq layers (vla-get-Layers doc)) (setq lay (vl-catch-all-apply 'vla-Item (list layers "CenterMark") ) ) (if (vl-catch-all-error-p lay) (setq lay (vla-Add layers "CenterMark")) ) ;; Blue layer, continuous linetype. (vla-put-Color lay 5) (vla-put-Linetype lay "Continuous") lay ) ;;; ============================================================ ;;; GET DIMENSION TYPE ;;; 3 = Diameter, 4 = Radius ;;; ============================================================ (defun ACM:GetDimType (ent / ed typ) (setq ed (entget ent)) (setq typ (cdr (assoc 70 ed))) (if typ (logand typ 7) 0 ) ) ;;; ============================================================ ;;; GET DIMENSION CENTER ;;; Diameter: midpoint of groups 10 and 15 ;;; Radius: group 10 ;;; ============================================================ (defun ACM:GetCenter (ent / ed typ p1 p2) (setq ed (entget ent)) (setq typ (ACM:GetDimType ent)) (cond ;; Diameter: derive center from the midpoint of definition points 10/15. ;; Group 15 alone can be the arrow/leader-side point in this drawing. ((= typ 3) (setq p1 (cdr (assoc 10 ed))) (setq p2 (cdr (assoc 15 ed))) (if (and p1 p2) (list (/ (+ (car p1) (car p2)) 2.0) (/ (+ (cadr p1) (cadr p2)) 2.0) (/ (+ (if (caddr p1) (caddr p1) 0.0) (if (caddr p2) (caddr p2) 0.0) ) 2.0 ) ) ) ) ;; Radius: use group 10 as in the original working version. ((= typ 4) (setq p1 (cdr (assoc 10 ed))) (if p1 (list (car p1) (cadr p1) (if (caddr p1) (caddr p1) 0.0) ) ) ) ) ) ;;; ============================================================ ;;; POINT DISTANCE SQUARED ;;; ============================================================ (defun ACM:DistanceSquared (p1 p2 / dx dy) (setq dx (- (car p1) (car p2))) (setq dy (- (cadr p1) (cadr p2))) (+ (* dx dx) (* dy dy)) ) ;;; ============================================================ ;;; CHECK FOR DUPLICATE CENTER ;;; ============================================================ (defun ACM:CenterExists (cen centers tol / item) (setq item centers) (while (and item (>= (ACM:DistanceSquared cen (car item)) (* tol tol) ) ) (setq item (cdr item)) ) (if item T nil) ) ;;; ============================================================ ;;; SAVE AND RESTORE CENTERMARK SYSTEM VARIABLES ;;; ============================================================ (setq *ACM-SYSVARS* '("CENTERLTYPE" "CENTERLAYER" "CENTERLTYPEFILE" "CENTERLTSCALE" "CENTERCROSSSIZE" "CENTERCROSSGAP" "CENTEREXE" "CENTERMARKEXE" ) ) (defun ACM:SaveCenterVars (/ v x) (setq *ACM-OLD-SYSVARS* nil) (foreach v *ACM-SYSVARS* (setq x (vl-catch-all-apply 'getvar (list v))) (if (not (vl-catch-all-error-p x)) (setq *ACM-OLD-SYSVARS* (cons (cons v x) *ACM-OLD-SYSVARS* ) ) ) ) ) (defun ACM:RestoreCenterVars (/ item) (foreach item *ACM-OLD-SYSVARS* (vl-catch-all-apply 'setvar (list (car item) (cdr item)) ) ) (setq *ACM-OLD-SYSVARS* nil) (princ) ) (defun ACM:SetVarSafe (var val) (not (vl-catch-all-error-p (vl-catch-all-apply 'setvar (list var val) ) ) ) ) ;;; ============================================================ ;;; DRAWING UNITS AND EXTENSION LENGTH ;;; ============================================================ (defun ACM:MetricDrawingP () (member (getvar "INSUNITS") '(4 5 6 13 14 15 16 17) ) ) (defun ACM:ExtensionLength (/ units) (setq units (getvar "INSUNITS")) (cond ((= units 1) 0.125) ((= units 2) (/ 0.125 12.0)) ((= units 4) 3.175) ((= units 5) 0.3175) ((= units 6) 0.003175) (T 0.125) ) ) ;;; ============================================================ ;;; CONFIGURE NATIVE CENTERMARK ;;; ============================================================ (defun ACM:ConfigureCenterMark (/ ext) (ACM:SetVarSafe "CENTERLAYER" "CenterMark") (ACM:SetVarSafe "CENTERLTYPE" "ByLayer") (ACM:SetVarSafe "CENTERLTSCALE" 1.0) ;; Object-relative sizing; no startup size prompt. (ACM:SetVarSafe "CENTERCROSSSIZE" "0.1x") (ACM:SetVarSafe "CENTERCROSSGAP" "0.05x") ;; Enable extension lines. (ACM:SetVarSafe "CENTERMARKEXE" 1) (setq ext (ACM:ExtensionLength)) (ACM:SetVarSafe "CENTEREXE" ext) ;; Change the linetype definition file only for metric drawings. (if (ACM:MetricDrawingP) (ACM:SetVarSafe "CENTERLTYPEFILE" "acadiso.lin" ) ) T ) ;;; ============================================================ ;;; CREATE CROSSHAIR LINE IN SPECIFIED BLOCK ;;; ============================================================ (defun ACM:AddLineToBlock (block p1 p2 / obj) (setq obj (vl-catch-all-apply 'vla-AddLine (list block (vlax-3D-point p1) (vlax-3D-point p2) ) ) ) (if (vl-catch-all-error-p obj) nil (progn (vl-catch-all-apply 'vla-put-Layer (list obj "CenterMark") ) (vl-catch-all-apply 'vla-put-Color (list obj 256) ) (vl-catch-all-apply 'vla-put-Linetype (list obj "ByLayer") ) obj ) ) ) ;;; ============================================================ ;;; CREATE FALLBACK CROSSHAIR ;;; ============================================================ (defun ACM:CreateCrossHair (block cen radius / x y z arm gap ext outer ok) (if (and radius (> radius 0.0)) (progn (setq x (car cen) y (cadr cen) z (if (caddr cen) (caddr cen) 0.0) arm (* radius 0.10) gap (* radius 0.05) ext (ACM:ExtensionLength) outer (+ radius ext) ok T ) ;; Two lines form the small central cross. (if (not (and ;; One continuous horizontal line. (ACM:AddLineToBlock block (list (- x arm) y z) (list (+ x arm) y z) ) ;; One continuous vertical line. (ACM:AddLineToBlock block (list x (- y arm) z) (list x (+ y arm) z) ) ) ) (setq ok nil) ) ;; Four outer extensions, separated by a small gap. (if (and ok (> outer (+ arm gap))) (if (not (and ;; Left extension. (ACM:AddLineToBlock block (list (- x (+ arm gap)) y z) (list (- x outer) y z) ) ;; Right extension. (ACM:AddLineToBlock block (list (+ x (+ arm gap)) y z) (list (+ x outer) y z) ) ;; Bottom extension. (ACM:AddLineToBlock block (list x (- y (+ arm gap)) z) (list x (- y outer) z) ) ;; Top extension. (ACM:AddLineToBlock block (list x (+ y (+ arm gap)) z) (list x (+ y outer) z) ) ) ) (setq ok nil) ) ) ok ) nil ) ) ;;; ============================================================ ;;; ARC CENTER FROM THREE POINTS ;;; Returns the WCS center of a circular arc segment. ;;; Returns nil for collinear or nearly collinear points. ;;; ============================================================ (defun ACM:ArcCenter3Points (p1 p2 p3 / x1 y1 x2 y2 x3 y3 d s1 s2 s3 cx cy cz) (if (and p1 p2 p3 (numberp (car p1)) (numberp (cadr p1)) (numberp (car p2)) (numberp (cadr p2)) (numberp (car p3)) (numberp (cadr p3)) ) (progn (setq x1 (car p1) y1 (cadr p1) x2 (car p2) y2 (cadr p2) x3 (car p3) y3 (cadr p3) ) (setq d (* 2.0 (+ (* x1 (- y2 y3)) (* x2 (- y3 y1)) (* x3 (- y1 y2)) ) ) ) (if (> (abs d) 1e-10) (progn (setq s1 (+ (* x1 x1) (* y1 y1)) s2 (+ (* x2 x2) (* y2 y2)) s3 (+ (* x3 x3) (* y3 y3)) ) (setq cx (/ (+ (* s1 (- y2 y3)) (* s2 (- y3 y1)) (* s3 (- y1 y2)) ) d ) ) (setq cy (/ (+ (* s1 (- x3 x2)) (* s2 (- x1 x3)) (* s3 (- x2 x1)) ) d ) ) (setq cz (/ (+ (if (numberp (caddr p1)) (caddr p1) 0.0 ) (if (numberp (caddr p2)) (caddr p2) 0.0 ) (if (numberp (caddr p3)) (caddr p3) 0.0 ) ) 3.0 ) ) (list cx cy cz) ) nil ) ) nil ) ) ;;; ============================================================ ;;; FIND MATCHING MODEL-SPACE CIRCLE, ARC, OR CURVED POLYLINE ;;; ============================================================ (defun ACM:FindCurve (dim cen spaceName / ss i ent ed typ c r best bestR tol endParam j p1 pm p2 cc rr ) (setq best nil bestR -1.0 tol *ACM-CENTER-TOL* ) ;; Search the named space. Paper-space dimensions first check their ;; own layout, then resolve through a floating viewport into Model space. (if (setq ss (ssget "_X" (list '(0 . "CIRCLE,ARC,LWPOLYLINE,POLYLINE") (cons 410 spaceName) ) ) ) (progn (setq i 0) (while (< i (sslength ss)) (setq ent (ssname ss i) ed (entget ent) typ (cdr (assoc 0 ed)) ) (cond ((member typ '("CIRCLE" "ARC")) (setq c (trans (cdr (assoc 10 ed)) ent 0) r (cdr (assoc 40 ed)) ) (if (and c r (> r 0.0) (<= (ACM:DistanceSquared cen c) (* tol tol) ) (> r bestR) ) (setq best ent bestR r ) ) ) ((member typ '("LWPOLYLINE" "POLYLINE")) (setq endParam (vl-catch-all-apply 'vlax-curve-getEndParam (list ent) ) ) (if (and (not (vl-catch-all-error-p endParam)) (> endParam 0) ) (progn (setq j 0) (while (< j (fix endParam)) (setq p1 (vlax-curve-getPointAtParam ent j) pm (vlax-curve-getPointAtParam ent (+ j 0.5)) p2 (vlax-curve-getPointAtParam ent (1+ j)) cc (ACM:ArcCenter3Points p1 pm p2) ) (if cc (progn (setq rr (distance cc p1)) (if (and (> rr 0.0) (<= (ACM:DistanceSquared cen cc) (* tol tol) ) (> rr bestR) ) (setq best ent bestR rr ) ) ) ) (setq j (1+ j)) ) ) ) ) ) (setq i (1+ i)) ) ) ) best ) ;;; ============================================================ ;;; TRANSFORM A BLOCK-DEFINITION POINT THROUGH ONE INSERT ;;; Handles insertion point, base point, XYZ scale, rotation and OCS. ;;; ============================================================ (defun ACM:BlockPointToWorld (pt ins base / ed ip sx sy sz ang dx dy dz rx ry q) (setq ed (entget ins) ip (cdr (assoc 10 ed)) sx (if (cdr (assoc 41 ed)) (cdr (assoc 41 ed)) 1.0) sy (if (cdr (assoc 42 ed)) (cdr (assoc 42 ed)) 1.0) sz (if (cdr (assoc 43 ed)) (cdr (assoc 43 ed)) 1.0) ang (if (cdr (assoc 50 ed)) (cdr (assoc 50 ed)) 0.0) ) (if (null base) (setq base '(0.0 0.0 0.0))) (if (null (caddr pt)) (setq pt (list (car pt) (cadr pt) 0.0))) (if (null (caddr base)) (setq base (list (car base) (cadr base) 0.0))) (setq dx (* (- (car pt) (car base)) sx) dy (* (- (cadr pt) (cadr base)) sy) dz (* (- (caddr pt) (caddr base)) sz) rx (- (* dx (cos ang)) (* dy (sin ang))) ry (+ (* dx (sin ang)) (* dy (cos ang))) q (list (+ (car ip) rx) (+ (cadr ip) ry) (+ (caddr ip) dz) ) ) ;; INSERT coordinates are in the INSERT's OCS. Convert the result to WCS. (trans q ins 0) ) ;;; ============================================================ ;;; FIND A MATCHING CURVE INSIDE A MODEL-SPACE INSERT ;;; Returns (nested-curve world-center point-on-curve insert radius). ;;; The pick point is transformed from the nested curve itself so CENTERMARK ;;; receives a point actually on the selected ARC or bulged polyline segment. ;;; The block definition is read only; no block contents are modified. ;;; ============================================================ (defun ACM:FindBlockCurve (dim cen spaceName / dimEd dimTyp meas targetR pickPt ss i ins insEd bname btr head headEd base bent ed typ cc rr wc sc sx sy endParam startParam j p1 pm p2 localC localR localPick worldPick err best bestC bestPick bestIns bestR bestErr tol ) (setq dimEd (entget dim) dimTyp (ACM:GetDimType dim) meas (cdr (assoc 42 dimEd)) pickPt (cdr (assoc 15 dimEd)) tol *ACM-CENTER-TOL* best nil bestErr nil ) (if (and meas (> meas 0.0) pickPt) (progn (setq targetR (if (= dimTyp 3) (/ meas 2.0) meas ) ) (if (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 410 spaceName) ) ) ) (progn (setq i 0) (while (< i (sslength ss)) (setq ins (ssname ss i) insEd (entget ins) bname (cdr (assoc 2 insEd)) sx (if (cdr (assoc 41 insEd)) (abs (cdr (assoc 41 insEd))) 1.0 ) sy (if (cdr (assoc 42 insEd)) (abs (cdr (assoc 42 insEd))) 1.0 ) ) ;; A non-uniform XY scale turns circular geometry into an ellipse. ;; Leave that case to the existing fallback rather than mis-mark it. (if (and bname (> sx 1e-12) (> sy 1e-12) (<= (abs (- sx sy)) 1e-8) ) (progn (setq btr (tblobjname "BLOCK" bname)) (if btr (progn (setq head (entnext btr) headEd (if head (entget head)) base (if (and headEd (= (cdr (assoc 0 headEd)) "BLOCK") ) (cdr (assoc 10 headEd)) '(0.0 0.0 0.0) ) ) (if (and headEd (= (cdr (assoc 0 headEd)) "BLOCK") ) (setq bent (entnext head)) (setq bent head) ) (while (and bent (/= (cdr (assoc 0 (entget bent))) "ENDBLK") ) (setq ed (entget bent) typ (cdr (assoc 0 ed)) localC nil localR nil localPick nil worldPick nil ) (cond ((member typ '("CIRCLE" "ARC")) (setq localC (trans (cdr (assoc 10 ed)) (if (assoc 210 ed) (cdr (assoc 210 ed)) '(0.0 0.0 1.0) ) 0 ) localR (cdr (assoc 40 ed)) startParam (vl-catch-all-apply 'vlax-curve-getStartParam (list bent) ) endParam (vl-catch-all-apply 'vlax-curve-getEndParam (list bent) ) ) (if (and (not (vl-catch-all-error-p startParam)) (not (vl-catch-all-error-p endParam)) ) (setq localPick (vl-catch-all-apply 'vlax-curve-getPointAtParam (list bent (/ (+ startParam endParam) 2.0) ) ) ) (setq localPick nil) ) (if (and localPick (not (vl-catch-all-error-p localPick)) ) (setq worldPick (ACM:BlockPointToWorld localPick ins base ) ) (setq worldPick nil) ) ) ((member typ '("LWPOLYLINE" "POLYLINE")) (setq endParam (vl-catch-all-apply 'vlax-curve-getEndParam (list bent) ) ) (if (and (not (vl-catch-all-error-p endParam)) (> endParam 0) ) (progn (setq j 0) (while (< j (fix endParam)) (setq p1 (vlax-curve-getPointAtParam bent j) pm (vlax-curve-getPointAtParam bent (+ j 0.5 ) ) p2 (vlax-curve-getPointAtParam bent (1+ j) ) cc (ACM:ArcCenter3Points p1 pm p2) localPick pm worldPick (ACM:BlockPointToWorld pm ins base) ) (if cc (progn (setq rr (distance cc p1) wc (ACM:BlockPointToWorld cc ins base ) sc (/ (+ sx sy) 2.0) err (abs (- (* rr sc) targetR)) ) (if (and (> rr 0.0) (<= (ACM:DistanceSquared cen wc) (* tol tol) ) (<= err tol) (or (null bestErr) (< err bestErr)) ) (setq best bent bestC wc bestPick worldPick bestIns ins bestR (* rr sc) bestErr err ) ) ) ) (setq j (1+ j)) ) ) ) ) ) ;; Circle and arc candidates use their entity center. (if (and localC localR (> localR 0.0)) (progn (setq wc (ACM:BlockPointToWorld localC ins base) sc (/ (+ sx sy) 2.0) err (abs (- (* localR sc) targetR)) ) (if (and (<= (ACM:DistanceSquared cen wc) (* tol tol)) (<= err tol) (or (null bestErr) (< err bestErr)) ) (setq best bent bestC wc bestPick worldPick bestIns ins bestR (* localR sc) bestErr err ) ) ) ) (setq bent (entnext bent)) ) ) ) ) ) (setq i (1+ i)) ) ) ) ) ) (if best (list best bestC bestPick bestIns bestR) ) ) ;;; ============================================================ ;;; CONVERT A PAPER-SPACE POINT THROUGH A LAYOUT VIEWPORT ;;; ============================================================ (defun ACM:PaperToModelPoint (pt vp / ed pc pw ph vc vh twist scale dx dy rx ry) (setq ed (entget vp) pc (cdr (assoc 10 ed)) pw (cdr (assoc 40 ed)) ph (cdr (assoc 41 ed)) vc (cdr (assoc 12 ed)) vh (cdr (assoc 45 ed)) twist (cdr (assoc 51 ed)) ) (if (and pt pc pw ph vc vh (> pw 0.0) (> ph 0.0) (> vh 0.0) ) (progn ;; Ignore the paper-space overall viewport (DXF group 69 = 1). (if (or (null (cdr (assoc 69 ed))) (> (cdr (assoc 69 ed)) 1) ) (progn (setq scale (/ ph vh)) (if (> scale 1e-12) (progn (setq dx (/ (- (car pt) (car pc)) scale) dy (/ (- (cadr pt) (cadr pc)) scale) ) ;; Invert the viewport's view twist. (if (null twist) (setq twist 0.0) ) (setq rx (- (* dx (cos twist)) (* dy (sin twist)) ) ) (setq ry (+ (* dx (sin twist)) (* dy (cos twist)) ) ) (list (+ (car vc) rx) (+ (cadr vc) ry) (if (caddr vc) (caddr vc) 0.0) ) ) ) ) ) ) ) ) ;;; ============================================================ ;;; GET THE MODEL-SPACE BLOCK ;;; ============================================================ (defun ACM:GetModelBlock (/ appObj doc layouts layout) (setq appObj (vlax-get-acad-object) doc (vla-get-ActiveDocument appObj) layouts (vla-get-Layouts doc) ) (setq layout (vl-catch-all-apply 'vla-Item (list layouts "Model") ) ) (if (vl-catch-all-error-p layout) nil (vla-get-Block layout) ) ) ;;; ============================================================ ;;; RESOLVE A PAPER-SPACE DIMENSION TO MODEL GEOMETRY ;;; Returns (curve model-center) or nil. ;;; ============================================================ (defun ACM:FindViewportCurve (dim cen / ss i vp ed pc pw ph mc curve result nestedInfo ) (setq result nil) (if (setq ss (ssget "_X" (list '(0 . "VIEWPORT") (cons 410 (getvar "CTAB")) ) ) ) (progn (setq i 0) (while (and (< i (sslength ss)) (null result)) (setq vp (ssname ss i) ed (entget vp) pc (cdr (assoc 10 ed)) pw (cdr (assoc 40 ed)) ph (cdr (assoc 41 ed)) ) ;; The geometric center of the dimension must lie in the ;; viewport's paper-space rectangle. (if (and pc pw ph (or (null (cdr (assoc 69 ed))) (> (cdr (assoc 69 ed)) 1) ) (<= (abs (- (car cen) (car pc))) (/ pw 2.0)) (<= (abs (- (cadr cen) (cadr pc))) (/ ph 2.0)) ) (progn (setq mc (ACM:PaperToModelPoint cen vp)) (if mc (progn ;; Preserve the proven top-level Modelspace search. (setq curve (ACM:FindCurve dim mc "Model")) (if curve (progn ;; For true circles/arcs use the entity's exact ;; WCS center. For bulged polylines retain the ;; transformed center that matched the arc segment. (if (member (cdr (assoc 0 (entget curve))) '("CIRCLE" "ARC") ) (setq mc (trans (cdr (assoc 10 (entget curve))) curve 0 ) ) ) ;; Third item is nil for ordinary geometry. (setq result (list curve mc nil)) ) ;; If no top-level curve matches, inspect individual ;; Modelspace INSERT references without editing definitions. (progn (setq nestedInfo (ACM:FindBlockCurve dim mc "Model")) (if nestedInfo (setq result (list (car nestedInfo) (cadr nestedInfo) nestedInfo ) ) ) ) ) ) ) ) ) (setq i (1+ i)) ) ) ) result ) ;;; ============================================================ ;;; CREATE NATIVE CENTERMARK IN MODEL SPACE ;;; ============================================================ (defun ACM:CreateNativeMark (curve cen modelP pickPt nestedP / before result after pt oldtab changed ucsPt nestedSel ) (if curve (progn (if pickPt (setq pt pickPt) (setq pt (vl-catch-all-apply 'vlax-curve-getClosestPointTo (list curve cen) ) ) ) (if (and (not (vl-catch-all-error-p pt)) pt ) (progn (setq oldtab (getvar "CTAB") changed nil ) ;; CENTERMARK must operate in Model space when the source ;; geometry belongs to Model space, not in the paper layout. (if (and modelP (/= (strcase oldtab) "MODEL")) (if (ACM:SetVarSafe "CTAB" "Model") (setq changed T) ) ) (if (or (not modelP) (= (strcase (getvar "CTAB")) "MODEL") ) (progn ;; AutoLISP point arguments to command-s are in the current ;; UCS. The nested-entity lookup also uses that UCS point. (setq ucsPt (trans pt 0 1)) ;; For block geometry, prove that this screen/world location ;; resolves to the exact nested entity found by ACM. This ;; avoids asking CENTERMARK to mark the INSERT itself. (if nestedP (progn (setq nestedSel (vl-catch-all-apply 'nentselp (list "" ucsPt) ) ) (if (or (vl-catch-all-error-p nestedSel) (null nestedSel) (not (eq (car nestedSel) curve)) ) (setq nestedSel nil) ) ) (setq nestedSel T) ) (if nestedSel (progn (setq before (entlast)) (setq result (vl-catch-all-apply 'command-s (list "_.CENTERMARK" ucsPt "" ) ) ) ;; Capture the result before returning to the layout. (setq after (entlast)) ) (setq result nil after before ) ) ) (setq result nil after before ) ) (if changed (ACM:SetVarSafe "CTAB" oldtab) ) (and (not (vl-catch-all-error-p result)) after (not (eq before after)) ) ) nil ) ) nil ) ) ;;; ============================================================ ;;; GET BLOCK FOR CURRENT LAYOUT ;;; ============================================================ (defun ACM:GetCurrentBlock (/ appObj doc layouts layout name) (setq appObj (vlax-get-acad-object)) (setq doc (vla-get-ActiveDocument appObj)) (setq name (getvar "CTAB")) (setq layouts (vla-get-Layouts doc)) (setq layout (vl-catch-all-apply 'vla-Item (list layouts name) ) ) (if (vl-catch-all-error-p layout) nil (vla-get-Block layout) ) ) ;;; ============================================================ ;;; PROCESS ONE DIMENSION ;;; ============================================================ (defun ACM:ProcessDimension (ent block centers / typ cen curve result ed meas radius nearPt tab resolved modelBlock targetBlock modelP nestedInfo nestedPick ) (setq typ (ACM:GetDimType ent) tab (getvar "CTAB") ) (if (member typ '(3 4)) (progn (setq cen (ACM:GetCenter ent) curve nil resolved nil modelP nil nestedInfo nil nestedPick nil targetBlock block ) (if cen (progn (if (= (strcase tab) "MODEL") ;; Model-space dimensions already report model coordinates. (progn (setq curve (ACM:FindCurve ent cen "Model") modelP T ) ;; If no top-level curve matches, inspect the contents of ;; individual Model-space INSERTs without editing definitions. (if (null curve) (progn (setq nestedInfo (ACM:FindBlockCurve ent cen "Model")) (if nestedInfo (setq curve (car nestedInfo) cen (cadr nestedInfo) nestedPick (caddr nestedInfo) modelBlock (ACM:GetModelBlock) targetBlock modelBlock ) ) ) ) (if (and curve (null nestedInfo) (member (cdr (assoc 0 (entget curve))) '("CIRCLE" "ARC") ) ) (setq cen (trans (cdr (assoc 10 (entget curve))) curve 0 ) ) ) ) ;; Preserve existing support for geometry drawn directly ;; in paper space before attempting viewport/model matching. (progn (setq curve (ACM:FindCurve ent cen tab)) (if (and curve (member (cdr (assoc 0 (entget curve))) '("CIRCLE" "ARC") ) ) (setq cen (trans (cdr (assoc 10 (entget curve))) curve 0 ) ) ) ;; No paper-space source found: try the viewports and ;; locate the matching Model-space curve. (if (null curve) (progn (setq resolved (ACM:FindViewportCurve ent cen)) (if resolved (progn (setq curve (car resolved) cen (cadr resolved) modelP T modelBlock (ACM:GetModelBlock) targetBlock modelBlock ) ;; A third return item identifies a nested block ;; candidate. Pass its exact transformed pick point ;; to the existing nested CENTERMARK validation. (if (caddr resolved) (setq nestedInfo (caddr resolved) nestedPick (caddr nestedInfo) ) ) ) ) ) ) ) ) (if curve (progn ;; Avoid duplicate centers across dimensions and layouts. (if (ACM:CenterExists cen centers *ACM-CENTER-TOL* ) (progn (ACM:DisableCenterMark ent) (list T centers) ) (progn (setq result nil) ;; Size the fallback from the actual source geometry, not the ;; dimension measurement. Dimension measurements can be expressed ;; in annotation/paper units and therefore over-size marks when the ;; source and dimension live in different spaces or viewports. (setq ed (entget ent) meas (cdr (assoc 42 ed)) radius nil ) (cond ;; FindBlockCurve returns the radius after applying the INSERT scale. ((and nestedInfo (nth 4 nestedInfo)) (setq radius (nth 4 nestedInfo)) ) ;; A circle or arc's DXF radius is already in its owning space. ((member (cdr (assoc 0 (entget curve))) '("CIRCLE" "ARC")) (setq radius (cdr (assoc 40 (entget curve)))) ) ;; For a bulged polyline, measure from its matched arc center to ;; the closest point on the curve in the same WCS coordinate space. (T (setq nearPt (vl-catch-all-apply 'vlax-curve-getClosestPointTo (list curve cen) ) ) (if (and nearPt (not (vl-catch-all-error-p nearPt))) (setq radius (distance cen nearPt)) ) ) ) ;; Retain the dimension value only as a last-resort size source. (if (or (null radius) (<= radius 0.0)) (if (and meas (> meas 0.0)) (setq radius (if (= typ 3) (/ meas 2.0) meas)) ) ) ;; Suppress the dimension's built-in center mark before creating ;; the selected replacement style. (ACM:DisableCenterMark ent) (cond ;; Crosshair mode deliberately bypasses the native command. ((= (strcase *ACM-MARK-STYLE*) "CROSSHAIR") (if (and targetBlock (ACM:CreateCrossHair targetBlock cen radius) ) (progn (setq result T) (setq *ACM-CROSSHAIR-COUNT* (1+ *ACM-CROSSHAIR-COUNT*)) ) ) ) ;; Native and Auto both try CENTERMARK first. (T (if (ACM:CreateNativeMark curve cen modelP nestedPick (if nestedInfo T nil) ) (progn (setq result T) (setq *ACM-NATIVE-COUNT* (1+ *ACM-NATIVE-COUNT*)) ) ) ;; Auto alone falls back when native creation is unavailable ;; or cannot resolve the target geometry. (if (and (not result) (= (strcase *ACM-MARK-STYLE*) "AUTO") targetBlock (ACM:CreateCrossHair targetBlock cen radius) ) (progn (setq result T) (setq *ACM-CROSSHAIR-COUNT* (1+ *ACM-CROSSHAIR-COUNT*)) ) ) ) ) ;; Only suppress the dimension's own center mark after ;; a replacement exists, or an equivalent mark exists. (if result (progn (ACM:DisableCenterMark ent) (list T (cons cen centers)) ) (list nil centers) ) ) ) ) (list nil centers) ) ) (list nil centers) ) ) (list nil centers) ) ) ;;; ============================================================ ;;; PROCESS SELECTION SET ;;; ============================================================ (defun ACM:ProcessSelection (ss block / i ent result centers count dims) (setq i 0 centers *ACM-CENTERS* count 0 dims nil ) ;; Process larger measured radii first. Concentric dimensions otherwise ;; depend on selection-set/database order: a smaller feature can claim the ;; shared center and cause the larger feature to be skipped as a duplicate. (if ss (progn (repeat (sslength ss) (setq dims (cons (ssname ss i) dims) i (1+ i) ) ) (setq dims (vl-sort dims '(lambda (a b) (> (if (= (ACM:GetDimType a) 3) (/ (if (cdr (assoc 42 (entget a))) (cdr (assoc 42 (entget a))) 0.0 ) 2.0 ) (if (= (ACM:GetDimType a) 4) (if (cdr (assoc 42 (entget a))) (cdr (assoc 42 (entget a))) 0.0 ) 0.0 ) ) (if (= (ACM:GetDimType b) 3) (/ (if (cdr (assoc 42 (entget b))) (cdr (assoc 42 (entget b))) 0.0 ) 2.0 ) (if (= (ACM:GetDimType b) 4) (if (cdr (assoc 42 (entget b))) (cdr (assoc 42 (entget b))) 0.0 ) 0.0 ) ) ) ) ) ) (foreach ent dims (setq result (ACM:ProcessDimension ent block centers)) (if (car result) (progn (setq centers (cadr result) *ACM-CENTERS* centers count (1+ count) ) ) ) ) ) ) count ) ;;; ============================================================ ;;; PROCESS DIMENSIONS IN CURRENT SPACE ;;; ============================================================ (defun ACM:ProcessBlock (block / ss) (if (setq ss (ssget "_X" (list '(0 . "DIMENSION") (cons 410 (getvar "CTAB")) ) ) ) (ACM:ProcessSelection ss block) 0 ) ) ;;; ============================================================ ;;; PROCESS MODEL AND ALL PAPER-SPACE LAYOUTS ;;; ============================================================ (defun ACM:ProcessAllLayouts (/ appObj doc layouts layout names name oldtab block count ) (setq appObj (vlax-get-acad-object)) (setq doc (vla-get-ActiveDocument appObj)) (setq layouts (vla-get-Layouts doc)) (setq oldtab (getvar "CTAB")) (setq names nil) (setq count 0) ;; Collect layout names first. (vlax-for layout layouts (setq names (cons (vla-get-Name layout) names)) ) ;; Process Model space. (if (ACM:SetVarSafe "CTAB" "Model") (progn (setq block (ACM:GetCurrentBlock)) (if block (setq count (+ count (ACM:ProcessBlock block))) ) ) ) ;; Process each paper-space layout. (foreach name names (if (/= (strcase name) "MODEL") (if (ACM:SetVarSafe "CTAB" name) (progn (setq block (ACM:GetCurrentBlock)) (if block (setq count (+ count (ACM:ProcessBlock block))) ) ) ) ) ) ;; Restore original layout. (ACM:SetVarSafe "CTAB" oldtab) count ) ;;; ============================================================ ;;; DISABLE DIMENSION'S BUILT-IN CENTER MARK ;;; ============================================================ (defun ACM:DisableCenterMark (ent / obj result) (setq obj (vl-catch-all-apply 'vlax-ename->vla-object (list ent) ) ) (if (vl-catch-all-error-p obj) nil (progn (setq result (vl-catch-all-apply 'vla-put-CenterType (list obj 2) ) ) (if (vl-catch-all-error-p result) nil (progn (vl-catch-all-apply 'vla-Update (list obj)) T ) ) ) ) ) ;;; ============================================================ ;;; MAIN COMMAND ;;; ============================================================ (defun c:ACM () (c:AddCtrMrk) ) (defun c:AddCtrMrk (/ *error* appObj doc oldtab oldclayer oldcolor oldlt block mode style ss count ) (defun *error* (msg) (ACM:RestoreCenterVars) (if oldclayer (setvar "CLAYER" oldclayer)) (if oldcolor (setvar "CECOLOR" oldcolor)) (if oldlt (setvar "CELTYPE" oldlt)) (if oldtab (ACM:SetVarSafe "CTAB" oldtab)) (if (and msg (/= msg "Function cancelled") (/= msg "quit / exit abort") ) (princ (strcat "\nError: " msg)) ) (princ) ) ;; Save original settings. (setq oldclayer (getvar "CLAYER")) (setq oldcolor (getvar "CECOLOR")) (setq oldlt (getvar "CELTYPE")) (setq oldtab (getvar "CTAB")) (ACM:SaveCenterVars) (setq *ACM-NATIVE-COUNT* 0) (setq *ACM-CROSSHAIR-COUNT* 0) (setq *ACM-CENTERS* nil) (setq appObj (vlax-get-acad-object)) (setq doc (vla-get-ActiveDocument appObj)) ;; Prepare the destination layer and native settings. (ACM:EnsureLayer) (ACM:ConfigureCenterMark) ;; Choose how ACM creates the replacement center mark. (initget "Native Crosshair Auto") (setq style (getkword "\nMark style [Native/Crosshair/Auto] <Auto>: " ) ) (if (null style) (setq style "Auto") ) (setq *ACM-MARK-STYLE* style) ;; Choose which dimensions to process. (initget "Select Current All") (setq mode (getkword "\nMode [Select/Current/All] <Select>: " ) ) (if (null mode) (setq mode "Select") ) (cond ;; SELECT ((= mode "Select") (setq block (ACM:GetCurrentBlock)) (if block (progn (princ "\nSelect DIMDIAMETER/DIMRADIUS dimensions: " ) (setq ss (ssget "_:L" (list '(0 . "DIMENSION") (cons 410 (getvar "CTAB")) ) ) ) (setq count (ACM:ProcessSelection ss block)) ) (setq count 0) ) ) ;; CURRENT ((= mode "Current") (setq block (ACM:GetCurrentBlock)) (if block (setq count (ACM:ProcessBlock block)) (setq count 0) ) ) ;; ALL ((= mode "All") (setq count (ACM:ProcessAllLayouts)) ) ) ;; Restore original system variables. (ACM:RestoreCenterVars) (setvar "CLAYER" oldclayer) (setvar "CECOLOR" oldcolor) (setvar "CELTYPE" oldlt) (ACM:SetVarSafe "CTAB" oldtab) (vla-Regen doc 1) (command-s "_.REGENALL") ;; Report results. (princ (strcat "\n\nACM complete." "\nMark style: " *ACM-MARK-STYLE* "\nDimensions processed: " (itoa count) "\nNative CENTERMARK objects: " (itoa *ACM-NATIVE-COUNT*) "\nCrosshairs: " (itoa *ACM-CROSSHAIR-COUNT*) "\nLayer: CenterMark" "\nNative cross size: 0.1x" "\nNative cross gap: 0.05x" ) ) (princ) ) (princ "\nAddCtrMrk loaded. Type AddCtrMrk or ACM to run.") (princ) Hopefully some my find this usefull.

Thanks BIGAL, and sorry for the late reply. One layout per sheet size, each holding only the title sheet at true size, is exactly the setup I was missing. I've added it to the notes that come with the DXF files: insert the sheet at 0,0 and scale 1 in a layout named after the size, make one layout per size, save as .dwt, then bring in the one you need with LAYOUT > Template. Thanks also for the Lisp document and the welcome.

It's not always beginners, some user have just developed bad habits over the years. A lot of times for me, it's imported geometry that was exported from 3D software packages and the mentioned profiles from SOLPROF and also SOLVIEW/SOLDRAW, that's why I have LISP to make sure anything that goes to the waterjet and/or plasma cutter are correct.

Besides checking the related settings, I have had to rotate and position the shape as well, though most of my SWEEP experience is with piping, so no worries if a circle twists.

Most slicing software will alert you to issues, I usually end up reducing the faces in the slicer to speed up printing and often you get a message that the slicer will clean them up for you. In CAD software, viewers, et.al. they may appear faceted or have a lack of detail, but may look just fine when printed. My Bambu Studio slicer lets you inspect layer by layer, no need for a viewer. STEP works better in some cases, but I am still testing different formats coming into the slicer and the quality and speed of the print. I plan to start trying to work on getting them to .obj (it maintains color and texture) and other formats that are excepted by my slicer and see what works best. Bambu Studio supports importing STL, STEP, 3MF, OBJ, AMF, and SVG files. Of those file formats, STL is the simplest and if done correctly, they usually print out just fine, particularly if it is something simple to begin with. Actually, models I make seem to be printing well and fairly fast, not so much the models you download from the marketplace, I almost always have to inspect and tweak those, if not outright redo from scratch.

I still try to think about LT usage when redoing an old LISP and creating new LISP, but it's not a real priority. If those that use LT around here need something done with a LISP and we can't find one that runs on LT, I can see if it's adjustable to be made to work or I can just do it for them. I originally asked this because an engineer with AutoCAD LT needed to convert a bunch of DGNs, I did end up converting a lot of folders with my LISP, but in the end the company that sent us the DGNs sent the exported from Autoplant .dwgs, etc., the DGNs we had converted okay, but IIRC some information was missing here and there for some of the files.

I was looking for something quick and simple yesterday - thanks. Now the not so quick part, I decided to make the DCL file as 'create on demand' style, and then tweak it a touch.... and then sent it through Al... a bit updated does what I want now. (Al was reasonably competent in it saved me about an hour copy-paste from my reference LISPs) Edit: Oh, for LT... forgetting the reason I was looking - shortcut links use VLAX code and I think the desktop part needs amending too - shortcuts are bypassed - won't work in LT - desktop I'll come back to (defun c:gf ( / DriveList CurDrive SubfolderList CurSubfolder GetFolderOldErr GetFolderDcl CurPath PathHistoryList MyResult) (defun GetFolder_init ( / MyDrawingDrive ) (setq GetFolderDcl (load_dialog "GetFolder")) (setq GetFolderOldErr *error*) (setq *error* GetFolderErr) (MakeDriveList) (setq CurPath (getvar "DWGPREFIX")) ;; Current drawing folder (setq DrawingDrive (substr CurPath 1 2)) ;; Drive (setq CurDrive (vl-position DrawingDrive DriveList)) (if (null CurDrive) (setq CurDrive 0)) ; End If (setq PathHistoryList (list CurPath)) (MakeSubfolderList CurPath) ) ; End GetFolder_init (defun GetFolder_exit ( / ) (setq CurPath CurPath) ) ; End GetFolder_exit (defun GetFolderErr ( s / ) (GetFolder_exit) (if GetFolderOldErr (setq *error* GetFolderOldErr) (setq *error* '()) ) ; End If ) ; End GetFolderErr (defun MakeDriveList ( / ascii-code drive ) (setq DriveList '()) (setq ascii-code 67) ;; ASCII code C = 67, Z = 90 (while (<= ascii-code 90) (setq drive (strcat (chr ascii-code) ":") ) (if (vl-file-directory-p drive) (setq DriveList (append DriveList (list drive))) ) ; End If (setq ascii-code (1+ ascii-code)) ) ; End While ) ; End MakeDriveList (defun MakeSubfolderList ( dir / MyFolderList MyShortcutList ) (if (and dir (= (type dir) 'STR) (vl-file-directory-p dir) ) ; End And (progn (setq MyFolderList (vl-directory-files dir nil -1) ) ;; Folders (if (= (getvar 'program) "LT") (setq SubfolderList (append (list "<-") MyFolderList )) ;;LT vl-dirctoryfiles might not work (progn (setq MyShortcutList (vl-directory-files dir "*.lnk" 1) ) ;; Shortcuts (setq SubfolderList (append (list "<-") MyFolderList MyShortcutList )) ) ; end progn ) ; end if ) ; End Progn (setq SubfolderList (list "<-")) ) ; End If (setq SubfolderList (vl-remove "." SubfolderList) ) (setq SubfolderList (vl-remove ".." SubfolderList)) (if (wcmatch CurPath "@`:") (setq SubfolderList (vl-remove "<-" SubfolderList)) ) ; End If ) ; End MakeSubfolderList (defun UpdateSubfolder ( $value / MyShortcut MyTarget MyShell ) (setq CurSubfolder (nth (atoi $value) SubfolderList )) (cond ((equal CurSubfolder "<-") ;; Back to previous folder (if (= (length PathHistoryList) 1) ;; top level (progn (setq CurPath (car PathHistoryList)) ) (progn (setq CurPath (cadr PathHistoryList)) (setq PathHistoryList (cdr PathHistoryList)) ) ; end progn ) ; end if ) ; end cond ((wcmatch (strcase CurSubfolder) "*.LNK") ;; shortcut (if (= (getvar 'program) "LT") ;; LT doesn't do VLAX (progn ) (progn (setq MyShell (vlax-create-object "WScript.Shell")) (setq MyShortcut (vlax-invoke-method MyShell 'CreateShortcut (strcat CurPath "\\" CurSubfolder))) (setq MyTarget (vlax-get-property MyShortcut 'TargetPath)) (vlax-release-object MyShortcut) (vlax-release-object MyShell) (if (and ;; if lnk is a folder MyTarget (vl-file-directory-p MyTarget) ) ; End And (progn (setq PathHistoryList (append (list CurPath) PathHistoryList )) (setq CurPath MyTarget) ;; Jump to shortcut target ) ; End Progn ;; (alert "Shortcut does not point to a folder.") ) ; End If ) ; end progn lnk ) ; end if ) ; end cond (T ;; Normal folder (setq PathHistoryList (append (list CurPath) PathHistoryList )) (setq CurPath (strcat CurPath "\\" CurSubfolder) ) ;; Enter selected folder ) ; end cond T ) ; End Conds (MakeSubfolderList CurPath) ;; Rebuild folders and shortcuts for the new location ;; Replace existing DCL list contents (start_list "subfolder" 3) (mapcar 'add_list SubfolderList) (end_list) (set_tile "subfolder" "0") ;; Select first item in refreshed list (set_tile "path" CurPath) ;; Display new path ) ; End UpdateSubfolder (defun InitDialog ( / ) (start_list "drive") (mapcar 'add_list DriveList) (end_list) (set_tile "drive" (itoa CurDrive)) ;; Select the drive containing the current drawing (start_list "subfolder") (mapcar 'add_list SubfolderList) (end_list) (set_tile "path" CurPath) ;; Display the current drawing folder ) ; End InitDialog (defun GetFolder_dialog ( / fname GF drv MyDclFile dcl_id MyFile) ;; Create DCL file ;;Start DCL (setq GF (open (setq fname (vl-filename-mktemp "GetFolder" (getvar "TEMPPREFIX") ".dcl")) "w")) ;;Header (write-line "SelLays : dialog {" GF) (write-line " key = \"Folder\";" GF) (write-line " label = \"GetFolder (RLX-10/04)\";" GF) (write-line " spacer;" GF) ;;Stuff (write-line " :row {alignment = top;" GF) (write-line " :column { width = 5; fixed_width = true; " GF) (write-line " : popup_list {key = \"drive\"; label = \"Drive\"; edit_width = 7; }" GF) (write-line " }" GF) ; end column (write-line " :column { width = 38; fixed_width = true; " GF) (write-line " }" GF) ; end column (write-line " }" GF) ; end row (write-line " :row {alignment = top;" GF) (write-line " :column { width = 6; fixed_width = true; " GF) (write-line " }" GF) ; end column (write-line " :column { width = 12; fixed_width = true; " GF) (write-line " :row {alignment = top;" GF) (write-line " : button { key = \"uplevel\"; label = \"↑ Last level\"; width = 5; }" GF) (write-line " : button { key = \"desktop\"; label = \"Desktop\"; width = 5; }" GF) (write-line " }" GF) ; end row (write-line " }" GF) ; end column (write-line " :column { width = 32; fixed_width = true; " GF) (write-line " }" GF) ; end column (write-line " }" GF) ; end row (write-line " :row {alignment = top;" GF) (write-line " : list_box { key = \"subfolder\"; label = \"Subfolders\"; height = 12; width = 25; }" GF) (write-line " }" GF) ; end row (write-line " :row {alignment = top;" GF) (write-line " : edit_box { key = \"path\"; label = \"Path\"; width = 25; }" GF) (write-line " }" GF) ; end row (write-line " ok_cancel;" GF) (write-line "}" GF) ; end dialog (close GF) (setq dcl_id (load_dialog fname)) (if (and dcl_id (new_dialog "SelLays" dcl_id) ) ; End And (progn (InitDialog) (action_tile "drive" " (UpdateDrive $value)" ) (action_tile "desktop" "(UpdateDesktop)" ) (action_tile "uplevel" "(UpdateUpLevel)" ) (action_tile "subfolder" "(UpdateSubfolder $value)" ) (action_tile "path" "(UpdatePath $value)" ) (action_tile "accept" "(done_dialog 1)" ) (action_tile "cancel" "(done_dialog 0)" ) (setq drv (start_dialog)) (cond ((= drv 0) (setq CurPath nil) ) ((= drv 1) (setq CurPath CurPath) ) ) ; End Cond ) ; End Progn ) ; End If (if dcl_id (unload_dialog dcl_id) ) ) ; End GetFolder_dialog (defun UpdateDrive ( $value / ) (setq CurDrive (atoi $value) ) (setq CurPath (nth CurDrive DriveList) ) (MakeSubfolderList CurPath) (start_list "subfolder") (mapcar 'add_list SubfolderList) (end_list) (setq PathHistoryList (list CurPath) ) (set_tile "path" CurPath) ) ; End UpdateDrive (defun UpdatePath ( dir / ) (if (and dir (= (type dir) 'STR) (vl-file-directory-p dir) ) ; End And (setq CurPath dir) (alert "Invalid Path") ) ; End If ) ; End UpdatePath (defun UpdateUpLevel ( / MyParentPath ) ;; Remove trailing slash if present (if (or (= (substr CurPath (strlen CurPath) 1) "\\") (= (substr CurPath (strlen CurPath) 1) "/") ) ; Endor (setq CurPath (substr CurPath 1 (1- (strlen CurPath))) ) ) ; End If (setq MyParentPath (vl-filename-directory CurPath)) ;; parent folder (if MyParentPath (progn (setq CurPath MyParentPath) (MakeSubfolderList CurPath) ;; Refresh subfolder list (start_list "subfolder") (mapcar 'add_list SubfolderList) (end_list) (set_tile "path" CurPath) ;; Update displayed path (setq PathHistoryList (list CurPath)) ;; Reset history from new location ) ; End Progn ) ; End If ) ; End UpdateUpLevel (defun UpdateDesktop ( / MyShell MyDesktop ) ;;Double check for none VLAX for LT (if (= (getvar 'program) "LT") (progn ) (progn (setq MyShell (vlax-create-object "WScript.Shell") ) (setq MyDesktop (vlax-invoke-method (vlax-get-property MyShell 'SpecialFolders) 'Item "Desktop")) (vlax-release-object MyShell) ) ) (if (and MyDesktop (vl-file-directory-p MyDesktop) ) ; End And (progn (setq CurPath MyDesktop) (MakeSubfolderList CurPath) (start_list "subfolder") (mapcar 'add_list SubfolderList) (end_list) (set_tile "path" CurPath) (setq PathHistoryList (list CurPath)) ) ; End Progn (alert "Desktop folder not found.") ) ; End If ) (GetFolder_init) (GetFolder_dialog) (setq MyResult (GetFolder_exit)) MyResult )

Have you ever used SWEEP to create a 3D shape along a curved path, but the profile gradually twists instead of maintaining the orientation you expected? This can happen when the profile orientation changes along the path. One thing worth checking is the SWEEP alignment and twist settings. I also check the profile's starting position and orientation before running the command. For more predictable results, I test the sweep with a simple profile first and adjust the settings before using the actual geometry. Have you faced unexpected twisting with SWEEP? Which settings do you normally adjust to control it?

Have you ever created a detailed 3D solid that looks smooth in CAD, but appears faceted or loses some detail after exporting it for 3D printing? One important thing to check is the mesh quality used during export. A surface that looks smooth on screen may be approximated by a limited number of triangular faces in the exported mesh. I always recommend checking the exported STL in a mesh viewer before sending it for printing. Pay particular attention to curved surfaces, small holes, and fine details. What settings or tools do you use to maintain curved surface quality when exporting CAD models for 3D printing?

Absolutely. Checking geometry before CNC export can prevent a lot of downstream problems. It's especially important when working with closed profiles for cutting. Thanks for sharing your experience.

If your old like me then you would know in the days when software came in a big box with a CD and paper manuals. There was at one stage a learn Autocad CD that got you to do lessons. It would check what you had drawn, I had one but not sure where it is now would have to put on a USB as no DVD/cd player in my laptop. Of course the paper manuals were so much easier to look how to do things in CAD, still have that manual.

Bricscad a Acad clone. Google it. What I am saying is that using lisp can draw what you want for basically any combination. It is the same as what was used in the draw windows, it ask for how many rows and columns and the size of the panels and then it's all drawn. The movie is in real time so shows how fast you can draw say what you want. It's a case of take the same style of method and functions inside a lisp. Each function does something eg Dimensions. I have over years of coding made shortcuts to make new code faster. May start by editing the window code to suit. DCL Dialouge Control Language it's about displaying on screen say a series of questions, in the image above enter the relevant values. Rather than say in lisp entering values one after the each other and can get one wrong and not realise it. Will see if can do an example for you.

I have it working on blocks that are dimensioned in the same space and curve objects in modelspace that are dimensioned in paperspace through a Viewport, but not blocks in modelspace dimensioned in paperspace through a Viewport, so a little more thinking. I also plan to keep the Fallback Crosshair option for older AutoCAD and any other CAD that doesn't have CENTERMARK command.

I've been developing CADstart, a browser-based 2D CAD learning platform, so I appreciate what you're trying to accomplish. I like the idea of helping beginners practice through challenges. One thing I'd be interested in is how you're introducing precision, object snaps, and dimensions before students move into more complicated exercises. Wishing you success with the project.

I work with 2D CAD drawings for protective foam packaging and CNC, so overlapping geometry is something I pay attention to. Duplicate lines can create problems downstream, especially when preparing closed profiles for cutting. I think it's worth teaching beginners to check their geometry early instead of waiting until export.

@indiancad The cylinders do not intersect. In addition, depending on the magnitude of the fillet radius, the fillet may need to be tangent to a cylindrical surface and a flat plane for a portion of its extent. I don't think filletedge or blend has much potential in this case. Try it out yourself.

That depends on the LISP. Check my GETLEN.lsp. as an example. A new get length LISP - AutoLISP, Visual LISP & DCL - AutoCAD Forums It gets perimeters and accounts for gaps and overlaps even in anonymous blocks. I made that due to SOLPROF profiles being a pain with the overlaps, etc.. So, sometimes a cleanup isn't required to get correct information, just a LISP or other code. I have one somewhere, but there are a few online "OVERKILL" type LISPs that work on blocks and sometimes better cleanup, something OVERKILL doesn't do all of the time. But, OVERKILL does under normal circumstances do fairly well, so a first run with that, or a second run if the drawing needs a real flattening, best to do that first. The waterjet/plasma cutter person at work does a lot of the work for those machines now, but I used to do all of it when those were first purchased. So I have done lots of cleanups for cutting. Luckily, most things I start are pretty clean except the SOLPROF and SOLVIEW/SOLDRAW objects. The software that came with the waterjet also can do some cleaning. So I have that as well.

dont quite get what u do (also the video above). Is that Bricks Cad and DCL (data control language) used in bricks cad?

If both cylinders are 3D solids and intersect, try FILLETEDGE on the intersection edge. If you need a smooth transition between separate cylindrical surfaces, BLEND may be more suitable.

That's a useful approach. Do your LISP routines also detect partially overlapping lines, or mainly exact duplicates?

Create sections (green) at several points along the object. Explode the sections then set a UCS to the plane of a section and create offset curves (red) with a distance equal to the desired fillet radius. I used 0.2. Add a circle of the fillet radus at the intersection of the offset curves and then trim the circle. Create a polyline (yelllow) to form a closed shape that includes the "fillet" arc (cyan). With pedit create closed polylines for the fillet sections then use loft to create the fillet solid. Union the two solids together.

I got to thinking about this and with some other LISPs it would be handy for my use to check if anyone has been altering a drawing on the network without permission. I normally look at the last saved time and date, but something like this might be useful to see what if anything was physically altered.

The two tubes run at different angles.

I gave the drawing a look. I am not 100% sure what you are trying to accomplish here, in order to fillet the two cylinders they need to share a common edge(s), the rectangular extrusion you have between them needs to be unioned as far as I know, if that's what you are trying to use, by the way it looks to be two of those. You might have better luck extruding a fillet shape between them and then union that to them.

I use a couple of LISPs.