All Activity
- Past hour
-
drawing problem ,
CyberAngel replied to riah's topic in AutoCAD 2D Drafting, Object Properties & Interface
How far should the centers of the radius-10 circles be from the center? In other words, how do you place the tabs (or whatever you call those circular protrusions)? It looks like the left and right sides of the central tab are different. Should they be symmetric? Once you place the tab circles, you should be able to draw the radius-4 circles as tangent to two of the tabs. Then it's just a matter of trimming. Here's what I got with the tabs placed on the diameter-80 arc: -
In the voronoi version some error checking before trying to call _polyline should be added indeed. And this function is dependent on how well the points are distributed over the line (ent->pts function). For the lines close together, more points should be given and with crossing lines it will not work at all. It only works if the lines stay in between the two polylines, and it doesn't in the example from OP:
- Today
-
Thanks. The animation in the GIF is from the calculations made in _cornerOffset. When it was (finally ) working I replaced the animation code with error checking. Didn't take the time to make it do both, but I did want to show how it worked here.
-
Jarvis joined the community
-
I think you're doing a very good job. PS: The animation in the GIF doesn't look the same as the one in the code.
-
@SLW210 here is a sample DWG Sample.dwg There are 4 'Object Data' tables in this DWG. I'd like to see each 'AutoCAD layer' on its own 'QGIS' layer, including only the assigned Object DATA'. MAPEXPORT only seems to allow to export all object data for some reason.
-
Sim01 joined the community
-
Yea with the resent forced update in windows 11 some things went funky for people.
-
Also noticed the CopyToClipboardAPI can be replaced with three lines if you add a reference to Microsoft Forms 2.0 Object Library Dim obj As New MSForms.DataObject ... If description <> "_" Then obj.SetText description obj.PutInClipboard MsgBox "Description '" & description & "' copied to clipboard." Else
-
I'm still sorting an attempt at the Bowyer–Watson version, but first I am trying to sort a few that are getting close. The export CSV and import a centerline is very close, but on the AxisExample .dwg it has a zig-zag glitch. I have one that draws the bisector lines that's close, but still misses the midpoint coming around those turns. I do have the one that appears very accurate on bends in one direction and the bends in the opposite direction depending on pick order. This would work if the AxisExample.dwg was in separate sections at the turns, maybe. I get a error: bad argument type: fixnump: nil with the AxisExample.dwg and some other errors on the original Example.dwg (Two vertices were added to a 2D pline (0) which had no vertices. and error: bad argument type: numberp: nil ) though the simple ones it draws the centerline with @marko_ribar's version. Every one of these fall short on the OPs AxisExample drawing, most in the same areas. So, I will probably keep at this for a while to see how close I can get it. For sure, nearly everyone of these are as good as and many much better than, the currently available solutions in AutoCAD. The solution suggested by Autodesk, PathAverage.lsp by Kent Cooper, fails miserably on most of the OP's examples, though seems to work in most cases and needs the polylines in the same direction. I still have work to do for my paying job, but hopefully I can bang out something soon.
-
caleb1 joined the community
-
Amani Dermine joined the community
-
I added extra checks on every vertex like @PGia suggested two weeks ago. Those I added to the offset-loop and it gives the best of both worlds. Every point that is calculated should be the exact middle because the offset is the same on both sides. Still not perfect, but pretty close I think. ;| ; Calculate centerline between two polylines - dexus ; Function checks intersections of the offsets of two lines to create a middle/avarage line. |; (defun c:cl (/ ent1 ent2 loop maxlen offset offsetdistance pts s1 s2 ss start LM:ProjectPointToLine LM:intersections _addPoints _avarageAngle _cornerOffset _doOffset _getAnglesAtParam _getLength _polyline _side _wait) (defun _polyline (pts) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length pts)) (cons 8 (getvar 'clayer)) (cons 70 0) ) (mapcar (function (lambda (x) (cons 10 x))) pts) ) ) ) (defun _side (pline pnt / cpt end target der) (setq cpt (vlax-curve-getClosestPointTo pline pnt) ; https://www.theswamp.org/index.php?topic=55685.msg610429#msg610429 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 _getLength (ent) (- (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) (vlax-curve-getDistAtParam ent (vlax-curve-getStartParam ent)) ) ) (defun _wait (msec) (not ( (lambda (start) (while (< (- (getvar 'millisecs) start) msec)) ) (getvar 'millisecs) ) ) ) (defun _addPoints (lst ent pts / len) (setq len (_getLength ent)) (setq lst (mapcar (function (lambda (pt) (list (/ (vlax-curve-getDistAtPoint ent pt) len) pt))) lst)) (setq pts (append lst pts)) ; Animation ; (setq pts (vl-sort pts (function (lambda (a b) (< (car a) (car b)))))) ; (redraw) ; ( ; (lambda (lst) ; (while (cadr lst) ; (grdraw (cadar lst) (cadadr lst) 3) ; (setq lst (cdr lst)) ; ) ; ) ; pts ; ) ; (vla-update ent) ; (_wait 40) ; End animation pts ) (defun _doOffset (offset / te1 te2 lst rtn) ; Global vars: pts ent1 ent2 s1 s2 (setq rtn (cond ((equal offset 0.0 1e-4) (if (setq lst (LM:intersections ent1 ent2 acExtendNone)) (setq pts (_addPoints lst ent1 pts)) ) lst ) ( (or ; Make offset (vl-catch-all-error-p (setq te1 (vl-catch-all-apply 'vlax-invoke (list ent1 'Offset (if s1 offset (- offset)))))) (vl-catch-all-error-p (setq te2 (vl-catch-all-apply 'vlax-invoke (list ent2 'Offset (if s2 offset (- offset)))))) (vla-put-color (car te1) 252) (vla-put-color (car te2) 252) ) (princ "\nOffset failed. ") nil ) ((setq lst (LM:intersections (car te1) (car te2) acExtendNone)) (setq pts (_addPoints lst (car te1) pts)) lst ) ) ) (if (and te1 (not (vl-catch-all-error-p te1))) (mapcar 'vla-delete te1)) (if (and te2 (not (vl-catch-all-error-p te2))) (mapcar 'vla-delete te2)) rtn ) ;| ; 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 (list (setq ang1 (vlax-curve-getFirstDeriv ent 1e-14)) (setq ang2 (vlax-curve-getFirstDeriv ent (- (fix (vlax-curve-getEndParam ent)) 1e-14))) ) (list (setq ang1 (vlax-curve-getFirstDeriv ent (+ pa 1e-14))) (setq ang2 (vlax-curve-getFirstDeriv ent (- pa 1e-14))) ) ) (setq ang1 (angle '(0 0 0) ang1)) (setq ang2 (angle '(0 0 0) ang2)) (list ang1 (* (+ ang1 ang2) 0.5) 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) (if (< (rem (+ ang1 pi) (+ pi pi)) (rem (+ ang2 pi) (+ pi pi)) ) (+ (* (- ang2 ang1) 0.5) ang1) (+ (* (- ang1 ang2) 0.5) ang2) ) ) ;| ; 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 ang2 ang3 index pt1 pt2 pt3 pt4 pt5 rtn tmp vertex) (setq vertex (fix (vlax-curve-getEndParam ent1)) halfPi (* pi 0.5) index 0) (repeat vertex (and (setq pt1 (vlax-curve-getPointAtParam ent1 index)) ; Point on corner (setq ang1 (_getAnglesAtParam ent1 index)) ; Angles of pt1 (setq tmp ; Temp line for finding the angle on the other side (entmakex (list '(0 . "line") (cons 10 (polar pt1 (+ (cadr ang1) halfPi) maxlen)) (cons 11 (polar pt1 (- (cadr ang1) halfPi) maxlen)) ) ) ) (setq pt2 (car (LM:intersections (vlax-ename->vla-object tmp) ent2 acExtendNone))) ; Point on other side (setq ang2 (_getAnglesAtParam ent2 (vlax-curve-getParamAtPoint ent2 pt2))) ; Angle of pt2 (if (equal (rem (car ang1) pi) (rem (car ang2) pi) 1e-9) ; Is parallel? (setq pt3 (mapcar (function (lambda (a b) (* (+ a b) 0.5))) pt1 pt2) ; Midpoint ang3 (car ang1)) ; Same angle als ang1 (setq pt3 (inters pt1 (polar pt1 (car ang1) 1) pt2 (polar pt2 (car ang2) 1) nil) ; Find center for bisector ang3 (_avarageAngle (angle pt1 pt3) (angle pt2 pt3))) ; Angle of bisector ) (setq pt4 (inters pt3 (polar pt3 ang3 1) pt1 (polar pt1 (+ (cadr ang1) 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 (entget tmp) (entdel tmp)) (setq index (1+ index)) ) rtn ) (if (not (while (cond ((not (setq ss (ssget '((0 . "LWPOLYLINE"))))) (princ "\nNothing selected. Try again...\n") ) ((/= (sslength ss) 2) (princ "\nSelect 2 polylines! Try again...\n") ) ((and (setq ent1 (ssname ss 0)) (setq ent2 (ssname ss 1)) (setq ent1 (vlax-ename->vla-object ent1)) (setq ent2 (vlax-ename->vla-object ent2)) ) nil ; Stop loop ) ) ) ) (progn (setq s1 (_side ent1 (vlax-curve-getStartPoint ent2))) (setq s2 (_side ent2 (vlax-curve-getStartPoint ent1))) (setq maxlen (* 1.1 (max (_getLength ent1) (_getLength ent2) (distance (vlax-curve-getStartPoint ent1) (vlax-curve-getStartPoint ent2))))) (setq offsetdistance (/ maxlen 1024.0)) (if (LM:intersections ent1 ent2 acExtendNone) (setq offset (- maxlen)) (setq offset 0.0) ) (mapcar '_doOffset (_cornerOffset ent1 ent2)) (mapcar '_doOffset (_cornerOffset ent2 ent1)) (while (progn (setq loop (cond ((> offset maxlen) nil) ((_doOffset offset) (setq start t)) ((not start) t) (start nil) ) ) (setq offset (+ offset offsetdistance)) loop ) ) (if pts (_polyline (mapcar 'cadr (vl-sort pts (function (lambda (a b) (< (car a) (car b))))))) ) ) ) (redraw) (princ) )
-
Extracting data to excel from selected objects on different layers
kidznok replied to Hsanon's topic in AutoLISP, Visual LISP & DCL
@BIGAL Could You have a time and maybe help me? I will be very grateful -
vahidiyan joined the community
-
This is a very simple test to make everything is inside the code including the images. next step would be to look at the Lee-mac example and use vectors rather than slides. Thanks to RLX for convert DCL. ; https://www.cadtutor.net/forum/topic/98827-the-coordinates-of-the-trapezoid/page/2/#comment-677242 ; Fill in 4 image dcl with vector images ; simple working example by AlanH Nov 2025 (setq imgslst (list (list (list 19 222 128 222 7) (list 128 222 128 114 7) (list 128 114 19 114 7) (list 19 114 19 222 7)) (list (list 37 202 119 202 7) (list 119 202 139 120 7) (list 139 120 17 120 7) (list 17 120 37 202 7)) (list (list 36 203 120 203 7) (list 120 203 101 161 7) (list 141 119 16 119 7) (list 16 119 36 203 7)(list 101 161 141 119 7)) (list (list 38 200 118 200 7) (list 118 200 99 160 7) (list 138 120 18 120 7) (list 55 168 38 200 7)(list 99 160 138 120 7)(list 55 168 18 120 7)) ) ) (defun VECTOR4 (dclkey imglst / i j) (setq i (/ (dimx_tile DCLKEY) 151.) j (/ (dimy_tile DCLKEY) 326.)) (start_image DCLKEY) (fill_image 0 0 (dimx_tile DCLKEY)(dimy_tile DCLKEY) -2) (foreach x imglst (vector_image (fix (* (car x) i))(fix (* (cadr x) j))(fix (* (caddr x) i))(fix (* (cadddr x) j))(last x)) ) (end_image) (princ) ) (defun makedcl ( / ) (setq dcl (vl-filename-mktemp nil nil ".dcl") ) (setq des (open dcl "w") ) (foreach x '( "// dd2x2 dialogue. Used by the d2x2 command in dd2x2.lsp." "// Called from the AutoCAD Release 12 Standard Menu." "dd2x2: dialog {" " label = \"Pick shape\";" " : column {" " : row {" " : image_button {" " key = \"22sq1\";" " width = 15;" " aspect_ratio = 1.0;" " color = 0;" " allow_accept = true;" " }" " : image_button {" " key = \"22sq2\";" " width = 15;" " aspect_ratio = 1.0;" " color = 0;" " allow_accept = true;" " }" " }" " : row {" " : image_button {" " key = \"22sq3\";" " width = 15;" " aspect_ratio = 1.0;" " color = 0;" " allow_accept = true;" " }" " : image_button {" " key = \"22sq4\";" " width = 15;" " aspect_ratio = 1.0;" " color = 0;" " allow_accept = true;" " }" " }" " }" "ok_cancel;" "}" ) (write-line x des ) ); foreach (close des) (princ) ) (defun wow ( / x ans dcl keynum imgsitem dclkey ) (makedcl) (setq dcl_id (load_dialog dcl)) (if (not (new_dialog "dd2x2" dcl_id) ) (exit) ) (setq keynum 1) (repeat 4 (setq imgsitem (nth (- keynum 1) imgslst)) (setq dclkey (strcat "22sq" (rtos keynum 2 0))) (VECTOR4 dclkey imgsitem) (setq keynum (1+ keynum)) ) (action_tile "22sq1" "(setq ans $key)(done_dialog)") (action_tile "22sq2" "(setq ans $key)(done_dialog)") (action_tile "22sq3" "(setq ans $key)(done_dialog)") (action_tile "22sq4" "(setq ans $key)(done_dialog)") (action_tile "accept" "(setq ans $key)(done_dialog)") (action_tile "cancel" "(setq ans $key)(done_dialog)") (start_dialog) (unload_dialog dcl_id) (vl-file-delete dcl) (princ (strcat "\nsq picked = " ans)) (princ) ) (wow)
-
I made some simple shapes and used Vectorize to do just that, here are some samples. next step is to look at Lee-Mac example. Only read the vectors pattern in the following code. ;******************************************************************************** ; Function to draw a vector image within a dialogue Image tile or Image Button. * ; Argument: 'DCLKEY' - the dcl key of the image tile/button to be filled. * ; Do NOT edit the dcl dimension text below, this is needed by Vectorize. * ;******************************************************************************** ; Compiled for dcl dimensions of width,24.92, height,24.97, * ;******************************************************************************** (defun VECTOR1 (DCLKEY / i j) (setq i (/ (dimx_tile DCLKEY) 151.) j (/ (dimy_tile DCLKEY) 326.)) (start_image DCLKEY) (fill_image 0 0 (dimx_tile DCLKEY)(dimy_tile DCLKEY) -15) (foreach x '((19 222 128 222 7) (128 222 128 114 7) (128 114 19 114 7) (19 114 19 222 7)) (vector_image (fix (* (car x) i))(fix (* (cadr x) j))(fix (* (caddr x) i))(fix (* (cadddr x) j))(last x))) (end_image) (princ) ) (defun VECTOR2 (DCLKEY / i j) (setq i (/ (dimx_tile DCLKEY) 151.) j (/ (dimy_tile DCLKEY) 326.)) (start_image DCLKEY) (fill_image 0 0 (dimx_tile DCLKEY)(dimy_tile DCLKEY) -15) (foreach x '((37 202 119 202 7) (119 202 139 120 7) (139 120 17 120 7) (17 120 37 202 7)) (vector_image (fix (* (car x) i))(fix (* (cadr x) j))(fix (* (caddr x) i))(fix (* (cadddr x) j))(last x))) (end_image) (princ) ) (defun VECTOR3 (DCLKEY / i j) (setq i (/ (dimx_tile DCLKEY) 151.) j (/ (dimy_tile DCLKEY) 326.)) (start_image DCLKEY) (fill_image 0 0 (dimx_tile DCLKEY)(dimy_tile DCLKEY) -15) (foreach x '((36 203 120 203 7) (120 203 101 161 7) (141 119 16 119 7) (16 119 36 203 7) (101 161 141 119 7)) (vector_image (fix (* (car x) i))(fix (* (cadr x) j))(fix (* (caddr x) i))(fix (* (cadddr x) j))(last x))) (end_image) (princ) ) (defun VECTOR4 (DCLKEY / i j) (setq i (/ (dimx_tile DCLKEY) 151.) j (/ (dimy_tile DCLKEY) 326.)) (start_image DCLKEY) (fill_image 0 0 (dimx_tile DCLKEY)(dimy_tile DCLKEY) -15) (foreach x '((38 200 118 200 7) (118 200 99 160 7) (138 120 18 120 7) (55 168 38 200 7) (99 160 138 120 7) (55 168 18 120 7)) (vector_image (fix (* (car x) i))(fix (* (cadr x) j))(fix (* (caddr x) i))(fix (* (cadddr x) j))(last x))) (end_image) (princ) ) (setq imgslst (list (list (list 19 222 128 222 7) (list 128 222 128 114 7) (list 128 114 19 114 7) (list 19 114 19 222 7)) (list (list 37 202 119 202 7) (list 119 202 139 120 7) (list 139 120 17 120 7) (list 17 120 37 202 7)) (list (list 36 203 120 203 7) (list 120 203 101 161 7) (list 141 119 16 119 7) (list 16 119 36 203 7)(list 101 161 141 119 7)) (list (list 38 200 118 200 7) (list 118 200 99 160 7) (list 138 120 18 120 7) (list 55 168 38 200 7)(list 99 160 138 120 7)(list 55 168 18 120 7)) ) ) Watch this psace. VECTORIZE.lsp
-
Yeah Lee's code is brilliant as usual. Nice way the image changes. Two things, Use Rlx convert DCL to lsp so dcl code is in lisp. Will have a think about vectors have some code some where.Convert dcl 2 lisp rlx.lsp
-
Try this. Note only do one direction at a time do lefts exit and repeat to do rights. ; https://www.cadtutor.net/forum/topic/98817-create-polyline-automatically/ ; Custom draw pline by Alan H Nov 2025 Checking if pline is CW or CCW and set to CCW ; Orignal idea by Kent Cooper, 1 August 2018 Offsetinorout.lsp ; By Alan H July 2020 ; (defun c:wow ( / co-ord ht pt0 pt1 pty1a pt2 pt2a ht oldsnap) (defun c:wow ( / ) (defun AH:chkcwccw (ent / objnew area1 area2 obj minpoint maxpoint) (setq obj (vlax-ename->vla-object ent)) (vla-GetBoundingBox obj 'minpoint 'maxpoint) (setq pointmin (vlax-safearray->list minpoint)) (setq pointmax (vlax-safearray->list maxpoint)) (setq dist (/ (distance pointmin pointmax) 20.0)) (vla-offset obj dist) (setq objnew (vlax-ename->vla-object (entlast))) (setq area1 (vlax-get objnew 'Area)) (vla-delete objnew) (vla-offset obj (- dist)) (setq objnew (vlax-ename->vla-object (entlast))) (setq area2 (vlax-get objnew 'Area)) (vla-delete objnew) (if (> area1 area2) (command "Pedit" ent "R" "") ) (princ) ) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq pt1 (getpoint "\nPick 1st point ")) (setvar 'osmode 128) (setq pt2 (getpoint pt1 "\nPick 2nd point on object ")) (setvar 'osmode 0) (setq pt0 (polar pt1 (/ pi 2.0) 4.0)) (command "pline" (setq pt1a (polar pt0 0.0 1.85)) (setq pt2a (polar pt1a (* 1.5 pi) 2.2)) (setq pt3 (polar pt2a pi 3.7)) (setq pt4 (polar pt3 (/ pi 2.0) 2.2)) "C" ) (setq ent (car (entsel "\Pick End Rectangle "))) (AH:chkcwccw ent) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))) (setq mp (mapcar '* (mapcar '+ (nth 1 co-ord) (nth 2 co-ord)) '(0.5 0.5))) (setq pt4 (polar mp (* 1.5 pi) (* 0.4 (distance (nth 0 co-ord) (nth 1 co-ord))))) (setq pt5 (mapcar '* (mapcar '+ (nth 0 co-ord) (nth 3 co-ord)) '(0.5 0.5))) (setq pt3 (list (car pt2) (cadr pt4))) (command "pline" pt0 pt1 pt2 pt3 pt4 pt5 "") (while (setq pt6 (getpoint "\nPick 1st point Enter to exit ")) (setq ang (angle pt2 pt6)) (if (and (>= ang (/ pi 2.0))(<= ang (* 1.5 pi))) (progn (setq pt0 (list (car pt6)(- (cadr pt0) 0.1))) (setq pt1 (list (car pt6)(- (cadr pt1) 0.1))) (setq pt2 (list (- (car pt2) 0.1)(- (cadr pt2) 0.1))) (setq pt3 (list (- (car pt3) 0.1)(- (cadr pt3) 0.1))) (setq pt4 (list (- (car pt4) 0.1)(- (cadr pt4) 0.1))) (setq pt5 (list (- (car pt5) 0.1)(cadr pt5))) ) (progn (setq pt0 (list (car pt6)(- (cadr pt0) 0.1))) (setq pt1 (list (car pt6)(- (cadr pt1) 0.1))) (setq pt2 (list (+ (car pt2) 0.1)(- (cadr pt2) 0.1))) (setq pt3 (list (+ (car pt3) 0.1)(- (cadr pt3) 0.1))) (setq pt4 (list (+ (car pt4) 0.1)(- (cadr pt4) 0.1))) (setq pt5 (list (+ (car pt5) 0.1)(cadr pt5))) ) ) (command "pline" (setq pt1a (polar pt0 0.0 1.85)) (setq pt2a (polar pt1a (* 1.5 pi) 2.2)) (setq pt3a (polar pt2a pi 3.7)) (polar pt3a (/ pi 2.0) 2.2) "C" ) (command "pline" pt0 pt1 pt2 pt3 pt4 pt5 "") ) (setvar 'osmode oldsnap) (princ) ) (C:wow)
-
Yea was thinking something like this. https://www.cadtutor.net/forum/topic/61373-need-help-with-proper-spacing-in-a-dialog-box/#findComment-506754
-
Headband4204 joined the community
- Yesterday
-
I only dabble in VBA but have these changed "kernel32" "user32" or maybe where you point to them, have had some VBA do this that refers to wrong library used.
-
My $0.05 you can draw any shape you want wether it be some form of trapezoid or a shape with 30 sides. It just comes down to writing code that matches the desired shape, Normal trapezoid length, height, angle Dbl angle length, height, angle1, angle2 Indented length, height, angle1, angle2, angle3 And so on., just ask which one you want first. You can even pop a image choice of what you want. Don't have trapezoids as images. Then for me pop a dcl for matching input. Ps @mhupp you don't have to put the AHlstbox in the code can use if (not ahlstbox)(Load "ahlstbox.lsp")) ; will load lisp code on the fly if not already loaded.
-
riah joined the community
-
ScottMC changed their profile photo -
mhupp started following Solidworks VBA for renaming components in an assembly
-
You can wrap the inputbox with ucase(trim( or even add things infront like i did with description eliminating lines of code. old ' --- Ask user if they want to Add or Remove description --- action = InputBox("Type 'A' to Add description or 'R' to Remove description:", "Action Choice", "A") action = UCase(Trim(action)) If action <> "A" And action <> "R" Then MsgBox "Invalid input.": Exit Sub ' --- Optional prefix --- prefix = "" Dim userInput As String userInput = InputBox("Enter component location prefix: T for Top, B for Bottom, leave blank for none:", "Prefix Option") userInput = UCase(Trim(userInput)) If userInput = "T" Then prefix = "Top_" If userInput = "B" Then prefix = "Bot_" ' --- Optional description (only if adding) --- If action = "A" Then description = InputBox("Enter description to append (leave blank for none):", "Optional Description") description = Trim(description) If description <> "" Then description = "_" & description If description <> "" Then CopyToClipboardAPI (description) MsgBox "Description '" & description & "' copied to clipboard." End If End If New ' --- Ask user if they want to Add or Remove description --- action = UCase(Trim(InputBox("Type 'A' to Add description or 'R' to Remove description:", "Action Choice", "A"))) If action <> "A" And action <> "R" Then MsgBox "Invalid input.": Exit Sub ' --- Optional prefix --- Dim userInput As String userInput = UCase(Trim(InputBox("Enter component location prefix: T for Top, B for Bottom, leave blank for none:", "Prefix Option"))) Select Case True Case userInput = "T" prefix = "Top_" Case userInput = "B" prefix = "Bot_" Case Else prefix = "" End Select ' --- Optional description (only if adding) --- If action = "A" Then description = "_" & Trim(InputBox("Enter description to append (leave blank for none):", "Optional Description")) If description <> "_" Then ;old code would still allow "_" to be copied to clipboard this skips and should prob exit sub if description is only "_" ? CopyToClipboardAPI (description) MsgBox "Description '" & description & "' copied to clipboard." Else MsgBox "Description is Blank " & vbCrLf & " Exiting Command" Exit Sub End If End If Didn't run past fso. please describe what your running into.
-
For fun, an another old code (in French) trapeze_dyn.lsp
-
KPark joined the community
-
These lisp's are to draw a trapezoid. I don't know if adding more features makes this completed code better. Id would have a separate code to make the irregular trapezoid and a main function to ask what shape you want to make. as far as dynamic mode modifying the poly in the drawing nothing more dynamic then that. this creates more options by call the irregular trapezoid lisp by itself or from a main list. you can even add other shapes to the main lisp. ;;----------------------------------------------------------------------------;; ;; All-Shapes or AS creates a DCL menu to pick what shape you want to create ;; and runs sub lisp of option picked ;; https://www.cadtutor.net/forum/topic/98827-the-coordinates-of-the-trapezoid/ (defun C:AS () (C:ALL-Shapes)) (defun C:All-Shapes (/ shplst shp) (setq shplst (list "Trapezoid" "Irregular Trapezoid" "Circle")) (setq shp (nth (ahlstbox "Pick a Shape" shplst 20 10) shplst)) (cond ((= shp "Trapezoid")(C:Trapezoid)) ((= shp "Irregular Trapezoid")(C:IrrTrapezoid)) ((= shp "Circle")(C:Cir)) ) ) ;; code by pkenewell (defun C:Trapezoid (/ bw p0 p1 p2 p3 p4 ra sa th) (if (and (setq bw (getreal "\nEnter the width of the Base: ") th (getreal "\nEnter the Height: ") sa (getreal "\nEnter the side angles: ") p0 (getpoint "\nSelect the insertion point: ") ) ) (progn (setq ra (* pi (/ sa 180.0)) p1 (list (- (car p0) (/ bw 2)) (cadr p0) (caddr p0)) p2 (list (+ (car p1) bw) (cadr p0) (caddr p0)) p3 (list (+ (car p2) (* (/ th (cos ra)) (sin ra))) (+ (cadr p0) th) (caddr p0)) p4 (list (- (car p1) (* (/ th (cos ra)) (sin ra))) (+ (cadr p0) th) (caddr p0)) ) (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)) (mapcar '(lambda (x) (cons 10 x)) (list p1 p2 p3 p4)) ) ) ) ) ) (defun C:IrrTrapezoid (/ bw p0 p1 p2 p3 p4 ra sa th) (alert "Code Needed for Irregular Trapezoid") (princ) ) (defun C:Cir () (while (setq p (getpoint "\nSelect Point Center of Circle: ")) (command "_.CIRCLE" p pause) ) ) ; listbox-ah a library lst box routine pick just one from ; By Alan H March 2019 ; (if (not AHlstbox)(load "Listbox-AH.lsp")) ;(setq ans (ahlstbox "Pick a number" (list "150" "200" "225" "250" "300" "375" "450" "600") 20 10)) ; ans is returned as item number selected of the list (defun AHlstbox (heading lst wid ht / fo fname lsec ) (setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w")) (write-line "AHlstbox : dialog {" fo) (write-line (strcat " label = " (chr 34) heading (chr 34) " ;" ) fo) (write-line " spacer ; " fo) (write-line " :list_box { " fo) (write-line (strcat " key=" (chr 34) "lst" (chr 34) " ; ") fo) (write-line (strcat " multiple_select=" (chr 34) "false" (chr 34) " ; ") fo) (write-line (strcat " width= " (rtos wid 2 0) " ; ") fo) (write-line (strcat " height=" (rtos ht 2 0 ) " ; ") fo) (write-line " } " fo) (write-line "spacer ;" fo) (write-line " ok_cancel ; " fo) (write-line " } " fo) (close fo) (setq dcl_id (load_dialog fname)) (if (not (new_dialog "AHlstbox" dcl_id)) (exit) ) (start_list "lst") (foreach itm lst (add_list itm)) (end_list) (action_tile "lst" "(setq lsec (atoi $value) )") (start_dialog) (unload_dialog dcl_id) (vl-file-delete fname) (princ lsec) )
-
CelA joined the community
-
I forgot all about this over the weekend, can you post a sample drawing? I'll try to find time this weekend to run through this in QGIS at home.
-
Solidworks VBA for renaming components in an assembly
SLW210 replied to dnenad's topic in SolidWorks
What is the error you get? SolidWorks changed a few VBA commands from 2024 to 2025, you'll probably get better results on a SolidWorks/Dassault Systems forum. A quick search on SolidWorks VBA changes between 2024 and 2025 might help. -
-
pluss joined the community
-
Hi Thank you all for these codes. However, I think this tool would be much better if the trapezoid angle could be adjusted interactively. It's often necessary to make adjustments to adapt it to the elements of the drawing.
