All Activity

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

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

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

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.

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.

I mean that one side of the trapezoid must usually be irregular.

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.

Post a drawing saved in acad 2012 or 2017, and then maybe we could help.

There is all sorts of problems with 3 arcs/circles touching. I don't think can do a reactor but as you have already drawn something you should be able with a lisp to do a re-calc the tangent points. A reactor would have to some how find all 3 objects I think a lisp would be easier. Can you clarify the 3 objects by posting a sample dwg with some examples.

@CivilTechSource I checked it out looks very useful, not sure the surface analysis will do what is required, ie use it to import Surface Styles. May need something similar export out the surface label styles details. Did you try it ?

The desire is to find a way to keep a 'live.circle' tangent connected to the three edges made/picked first. If any of the edges are changed, the circle will follow and adjust so it remains tan.connected. I could draw three lines and a circle but to activate a/this desired reactor is not my language (yet). 1. select or draw segments to attach cir.tan to 2. lsp: draw tangent circle using segments of 1. 3. lsp: activate reactor to maintain tangents btw.. here's a similar one which has reactor ability https://www.theswamp.org/index.php?topic=8861.msg113627#msg113627

A quick way to get true areas where you have Horizontal and vertical scales is to block all the cross sections and then reset the Hor & ver scale. Did you google this has been asked many times before. Of course the simplest is use a 3rd party Civil software add on they have volumes all built in. Will pay for its self very quickly.

Nice @alanjt. Have you thought about using a Mline you can set the offsets and layers. If it's wrong flip line. In a lisp can reverse lines, plines and mlines. The other thing of course is offset 3d line work, including +- to rl's.

The desire is to find a way to keep a 'live.circle' tangent connected to the three edges made/picked first. If any of the edges are changed, the circle will follow and adjust so it remains tan.connected. I could draw three lines and a circle but to activate a/this desired reactor is not my language (yet). 1. select or draw segments to attach cir.tan to 2. lsp: draw tangent circle using segments of 1. 3. lsp: activate reactor to maintain tangents

Here I've revised Helmut's code and made it faster. ;; ; ;; Pathfinding with the A* algorithm by ymg 22/07/2024 ; ;; ; ;; Revised a prog by HELMUT SCHRÖDER - heschr@gmx.de - 2014-09-14 ; ;; found at Cadtutor.net ; ;; ; ;; Kept the same format for edges list but added lines as valid choice ; ;; Format: (((x1 y1) (x2 y2)) (((x2 y2) (x3 y3))....(xn yn))) ; ;; ; ;; The user is asked to pick a start and an endpoint. ; ;; The program will find the shortest path in a network of connected ; ;; polylines and/or lines and draw a new polyline representing the result. ; ;; ; ;; Two lists of nodes openlst and closelst are created from the above ; ;; mentionned edges list. The format of a node list is: ; ;; (((Point) (Prev Point) Cumulated_Distance Estimated_Total_Distance)...) ; ;; ; ;; Main change from origina are: ; ;; - cons the list instead of append ; ;; - vl-sort the openlist instead of the quicksort ; ;; - Replaced and renamed some vars and subroutine. ; ;; - Added fuzz 1e-4 to all points comparison ; ;; - Change the get_path function ; ;; - Added line as possible edges ; ;; - Added an error handler ; ;; - Added a timer to the search portion of the program ; ;; ; ;; The above changes amounted to an acceleration of about 4x from the ; ;; original program. ; ;; : ;; If you compile this program to a .fas you'll get more than 10x faster. ; ;; ; (defun c:A* ( / ssl ssp i edges startp endp openlst closelst found acdoc Edgelay Pathlay Pathcol Pathlwt) (vl-load-com) ; Changes values of following 4 global variables to suit your need. ; (setq Edgelay "Edges" Pathlay "Path" Pathcol 1 ; 1=Red 2=Yellow etc. ; Pathlwt 70 ; lineweight for path 0.7mm ; ) (or acdoc (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))) (set_errhandler '("CLAYER" "OSMODE" "CMDECHO")) (setvar 'CMDECHO 0) (setvar 'OSMODE 1) (if (setq ssp (ssget '"X" (list (cons 0 "LWPOLYLINE") (cons 8 Edgelay)))) (foreach en (mapcar (function cadr) (ssnamex ssp)) (setq edges (append edges (mk_edge (listpol2d en)))) ) ) (if (setq ssl (ssget '"X" (list (cons 0 "LINE") (cons 8 Edgelay)))) (foreach en (mapcar (function cadr) (ssnamex ssl)) (setq edges (cons (list (butlast (vlax-curve-getstartpoint en)) (butlast (vlax-curve-getendpoint en))) edges)) ) ) (setq startp (butlast (getpoint "\nPick Start Point: ")) ; Startpoint - reduced to 2D ; endp (butlast (getpoint "\nPick End Point: ")) ; Endpoint - reduced to 2D ; openlst (list (list startp '(0 0) 0.0 (distance startp endp))) ; Add starting node to openlst ; ) (vla-startundomark acdoc) (setq ti (getvar 'MILLISECS)) (while (and openlst (not found)) (setq node (car openlst)) (if (equal (car node) endp 1e-4) (setq found T closelst (cons node closelst)) (setq closelst (cons node closelst) openlst (upd_openlst edges node endp (cdr openlst) closelst) ) ) ) (if found (mk_lwp (get_path closelst)) (alert "No path was found") ) (princ (strcat "\nExecution time:" (itoa (- (getvar 'MILLISECS) ti)) " milliseconds.")) (*error* nil) ) ;; ; ;; upd_openlst ; ;; ; ;; Each node of the openlst is passed to this sub and we scan the edges list ; ;; to find the corresponding edges. Then both points of the edges are tested ; ;; for equality to the nodes. The fixed cost (distance) is updated and so is ; ;; the estimated total distance. Updates are first put in a temporary node. ; ;; ; ;; We then proceed to test if the temp variable is already in the closelst ; ;; and proceed to the next edge. ; ;; ; ;; If temp is true and temp is not in closelst we go to the recursive sub ; ;; in_openlst which adjust the values and return the updated openlst : ;; ; ;; Upon return we sort the openlst on smallest estimated distance ; ;; and return the openlst to the main routine ; ;; ; (defun upd_openlst (edges node endp openlst closelst / pt fcost p1 p2 d temp) (setq pt (car node) fcost (caddr node)) (while edges (setq p1 (caar edges) p2 (cadar edges) edges (cdr edges) d (distance p1 p2) temp nil) ;Testing both points of an edge and building a temporary node ; (cond ((equal pt p1 1e-4) (setq temp (list p2 p1 (+ fcost d) (+ fcost d (distance p2 endp))))) ((equal pt p2 1e-4) (setq temp (list p1 p2 (+ fcost d) (+ fcost d (distance p1 endp))))) ) (if (and temp (not (memberfuzz (car temp) closelst))) (setq openlst (in_openlst temp openlst)) ) ) ; Keep openlist sorted on smallest Estimated Total Cost ; (print (vl-sort openlst (function (lambda(a b)(< (cadddr a) (cadddr b))))) ) ) ;in_lst Replaced by memberfuzz ; ;(defun in_lst (pt lst) ; (cond ; ((not lst) nil) ; ((equal pt (caar lst) 1e-4) lst) ; (T (in_lst pt (cdr lst))) ; ) ;) ; returns a new openlst with a double exchanged if cost is lower ; ;; ; (defun in_openlst (node lst) (cond ((not lst) (list node)) ((equal (car node) (caar lst) 1e-4) (if (< (cadddr node) (cadddr (car lst))) (cons node (cdr lst)) lst ) ) (T (cons (car lst) (in_openlst node (cdr lst)))) ) ) (defun in_openlst2 (node lst / s c) (setq s (splitat (caar node) lst) c (cadddr node)) (cond ((not lst) (list node)) ((not (car s)) (cons node (cadr s))) ((not (cadr s)) (cons node (car s))) (T (if (< (cadddr node) (cadddr (cadr s))) (append (car s) (cons node (cdr s))) lst )) ;(T (c ns node lst)) ) ) ;; ; ;; listpol2D by ymg (Simplified a Routine by Gile Chanteau ; ;; ; ;; Parameter: en, Entity Name or Object Name of Any Type of Polyline ; ;; ; ;; Returns: List of Points in 2D WCS ; ;; ; ;; Notes: Requires butlast function for 2d points. ; ;; ; (defun listpol2d (en / i lst) (repeat (setq i (fix (1+ (vlax-curve-getEndParam en)))) (setq lst (cons (butlast (vlax-curve-getPointAtParam en (setq i (1- i)))) lst)) ) ) ;; ; ;; mk_edge ; ;; ; ;; From a list of consecutives points as supplied by listpol2D, ; ;; Returns a list of edges (((x1 y1)(x2 y2)) ((x2 y2)(x3 y3))...) ; ;; ; (defun mk_edge (lst) (mapcar (function (lambda (a b) (list a b ))) lst (cdr lst)) ) ;; ; ;; butlast ; ;; ; ;; Returns a list without the last item ; ;; Used here mainly to change points to 2D ; ;; ; (defun butlast (lst) (reverse (cdr (reverse lst)))) ;; ; ;; get_path ; ;; ; ;; Returns The list of points of shortest path found from closelst. ; ;; ; (defun get_path (lst / path) (setq path (list (caar lst)) prev (cadar lst) lst (cdr lst)) (while (setq lst (memberfuzz prev lst)) (setq prev (cadar lst) path (cons (caar lst) path) ) ) path ) ;; ; ;; memberfuzz by Gile Chanteau ; ;; ; ;; Modified to work with nodes list ; ;; ; (defun memberfuzz (p lst) (while (and lst (not (equal p (caar lst) 1e-4))) (setq lst (cdr lst)) ) lst ) (defun splitat (p lst / tr) (while (and lst (not (equal p (caar lst) 1e-4))) (setq tr (cons (car lst) tr) lst (cdr lst)) ) (list (reverse tr) lst) ) (defun truncfuzz (p lst) (if (and lst (not (equal p (caar lst) 1e-4))) (cons (car lst) (truncfuzz p (cdr lst))) ) ) (defun posfuzz (p lst) (- (length lst) (length (memberfuzz p lst))) ) (defun rotleft (lst) (append (cdr lst) (list (car lst)))) (defun rotright (lst) (cons (last lst) (butlast lst))) ;; ; ;; mk_lwp ; ;; ; ;; Draw an lwpolyline given a point list ; ;; ; ;; Will be drawn on layer with color and lineweight defined by Variables ; ;; at beginnung of program. ; ;; ; (defun mk_lwp (pl) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 8 Pathlay) (cons 62 Pathcol) (cons 90 (length pl)) (cons 70 0) (cons 370 Pathlwt) ) (mapcar (function (lambda (a) (cons 10 a))) pl) ) ) ) ;; Error Handler by Elpanov Evgenyi ; (defun set_errhandler (l) (setq varl (mapcar (function (lambda (a) (list 'setvar a (getvar a)))) l)) ) (defun *error* (msg) (mapcar 'eval varl) (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))) (princ (strcat "\nError: " msg)) ) (vla-endundomark acdoc) (princ) ) (princ "A* to start") Astar rev3.lsp astar test.dwg

Nice. Thank you! I might be able to use this idea and tweak it with layer.

Might want to take those down and only upload a "Sample" drawing that doesn't have a title block with addresses and names or map. -edit Read this about polylines with arc's https://www.cadtutor.net/forum/topic/76326-selection-set-that-selects-objects-inside-a-curved-polyline/#findComment-603264 I think final code is on page 2.

See attached. It does not set layers, but I use this to generate curb offsets, based on multiple selected lines/etc. OffsetMultiple.lsp

apologies for the delayed response..... Can you try out the program on these files???? It works just fine on a new file made up of simple oblects... but just doesn't work on typical files on which i have to work further. Some times, it works on part of the objects.... (some objects get converted to "exist" layer and some dont) Are there some objects the survey drawing has which are causing the program to mess up ??? Just last try.... otherwise ill get back to my painstaking manual changes. Many many thanks ganges Sugam Survey with Tree details 14.8.25.dwg JC 6 ROYED ST-Basu survey.dwg

@ScottMC Please upload your SAMPLE.dwg and Sample.lsp as to see what you did and want to do

You can install the UKIE package and it has a built-in function to export and import styles. https://www.autodesk.com/sites/default/files/file_downloads/UKIE User Guide and Reference.pdf The Civil3D UKIE package is after 2023 or 2024 can be found in the AutoDesk Product page under Civil3d.

You're right, there is no mention of a layer that makes use of the dashed linetype in this project. I suggest you create a layer called "Arc", layer color "white" and assign it the "Dashed" linetype. There are only four overall (boundary) dimensions that will require manually created arcs. As for the title block and border draw it per the instructions. When completed use the Scale command to scale it up. The scale factor should be 50.

Your profile does not show what CAD software you are using. Yes, you need to post a drawing, preferably showing a before and after.

Have you got a sample drawing which might show bit more detail? should be possible though - simplest if you have the cross section drawn out is hatch, use properties to get the hatch area. I suspect it will be more complex than that