All Activity
- Past hour
-
Hey thanks for the reply The reason to convert to a small quantity of ARCs is because the SPLINE will become fabricated out of steel pipe. Fab method requires the shape to be fabricated from curved pipe segments. Unfortunately for this project, corkscrew/spiral pipe segments are not an option, so we are stuck with ARCs
- Today
-
Obviously, you can't use the original spline or you'd be doing that. It might help us to know why, though. I assume the goal is a 2D spline. Have you thought about starting with an actual spline? That way you can adjust the control points and their tangents, instead of using polyline arcs, which seems more complicated. If the goal is a 2D polyline, you can still draw it with a spline and then convert it to a polyline with SPLINEDIT. The more we know about your project, the better we can help. Right now I'm just guessing.
-
Another way to handle this issue is to define your title block as an AutoCAD block. That way the seal is already included. You put the seal on its own separate layer and turn that layer on when necessary. Another option is to use visibility states, so you only tap on a button to show the seal. But first, as the other answers suggest, clean up the seal block. That may take care of it.
-
Steven P started following Layer Table (Lines and Text)
-
If you want to do some thinking, this is the row that draws the line: (entmake (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt2) (cons 8 (cadr lay)))) work it out backwards from there and you might get close to what you want, need to adjust pt1 and pt2. Without looking properly I think BigAl has forgotten to increment something or a variable is set on the wrong side of a loop. Be good learning to see if you can get close?
-
Civil Drafting with AutoCAD Project-Civil Drafting with AutoCAD Project
ReMark replied to nelsonm's topic in Student Project Questions
BIGAL: I agree with you 100%. Unfortunately, Penn-Foster does not offer TIN software nor do they teach its use. And, unless a student has some basic knowledge of LISP to begin with, I doubt they would even think of taking advantage of its functionality. In this project the old way is the best the students can count on. Re: Points. The project is not being done in 3D; strictly 2D all the way. -
Thanks @BIGAL tested in AutoCAD 2024. some lines are not showing up. Anyway, the code by @nod684 works and it is according to my needs, Lines and Text not AutoCAD table. EDIT : I tried exploding the table and found that the 2nd line consists of 69 overlapping lines.
- Yesterday
-
Civil Drafting with AutoCAD Project-Civil Drafting with AutoCAD Project
BIGAL replied to nelsonm's topic in Student Project Questions
Welcome aboard, a little surprised that the exercise is to interpolate contour points. Given the availability of TIN software. That is a lot of points to tackle. Glad I am not doing that task. If I had to do it yes would use the method shown by @ReMark. But I would use a lisp to do the calculation making a Point at the correct distance then join all the points with a pline. I hope the little crosses are 3D so can pick pairs. Certainly have used the interpolation method in many other civil tasks, so well worth while learning how to do it. -
lamensterms started following 3D Spline to Arcs
-
Hey, I've got a project that requires me to reproduce/trace a 3D spline, with ARC segments. The goal being to reproduce the SPLINE as accurately as possible, with as few ARCs as possible Just hoping to get some thoughts on methods to approach this challenge. Right now my method is to divide the SPLINE into sections based on the local normal-ness of part of the SPLINE. Just visually trying to fit each ARC to a portion of the SPLINE I have to perform this task 8 times for this project so hoping to come up with a neat and robust method DWG attached - in this example I am trying to work to a limit of 5 ARCs TEMP.dwg
-
Civil Drafting with AutoCAD Project-Civil Drafting with AutoCAD Project
nelsonm replied to nelsonm's topic in Student Project Questions
Thank you so much for you help! I made a spreadsheet in excel, can you take a look? and I have another question: how can I know in which squares to place the interpolations? -
Civil Drafting with AutoCAD Project-Civil Drafting with AutoCAD Project
ReMark replied to nelsonm's topic in Student Project Questions
In other words, you are having trouble understanding the concept of interpolation, correct? The mathematical interpolation of contours goes like this. Let's say we have two spot elevations A & B. A = 32.7 and B = 54.0. The distance between A & B = 50 feet. We want to know where our 40-foot contour would fall between spot elevations A & B. First obtain the total elevation difference. This is done by subtracting A from B. 54.0 minus 32.7 = 21.3. Next, we want the difference in elevation between our 40-contour interval and the nearest spot elevation which in this case is A or 32.7. That works out to be 7.3. Now we need to calculate the distance (let's call this "d") we need to go from spot elevation A to our 40-foot contour. That takes the form of: d/7.3=50/21.3 or d=7.3*50/21.3 = 7.3*2.347 = 17.13 or the distance, in decimal feet, to our 40-foot contour. Got all that? Good. Now go start interpolating. -
khoa2132005 joined the community
-
Almost there its a table fixed a couple of bugs and done. Tested on a dwg with 500 layers a little slow takes a few seconds. ; https://www.cadtutor.net/forum/topic/99017-layer-table-lines-and-text/ ; Make a lgend of layers in dwg. ; Bt AlanH March 2026 (defun c:mktablay ( / colwidth doc lay lcol ldesc lname lst numrows objtable oldsnap pt pt1 pt2 rowheight) (defun CreateTableStyle ( / dicts dictobj key class custobj dwglays ) (setq dicts (vla-get-Dictionaries (vla-get-ActiveDocument(vlax-get-acad-object)))) (setq dictObj (vla-Item dicts "acad_tablestyle")) (vlax-for dname dictobj (if (= (vla-get-name dname) "DWGLAYERS" ) ; does it exist (princ "Found DWGLAYERS") (setq dwglays "No") ) ) (if (= dwglays "No") (progn (setq key "DWGLAYERS" class "AcDbTableStyle") (setq custObj (vla-AddObject dictObj key class)) (vla-put-Name custObj "DWGLAYERS") (vla-put-Description custObj "Dwg Index custom table style") (vla-put-BitFlags custObj 1) (vla-put-FlowDirection custObj acTableTopToBottom) (vla-put-HorzCellMargin custObj txtht ) (vla-put-VertCellMargin custObj txtht ) (vla-SetAlignment custObj (+ acDataRow acHeaderRow acTitleRow) acMiddleCenter) (vla-SetTextHeight custObj acDataRow txtht) (vla-SetTextHeight custObj acHeaderRow (* txtht 1.2)) (vla-SetTextHeight custObj acTitleRow (* txtht 1.5)) (vla-SetTextStyle custObj (+ acDataRow acHeaderRow acTitleRow) "Standard") ) ) (princ) ) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq txtht 1.5) (CreateTableStyle) (setvar 'ctablestyle "DWGLAYERS") (setq lays (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))) (setq lst '()) (vlax-for lay lays (setq lname (vlax-get lay 'name)) (setq lcol (vlax-get lay 'color)) (setq ldesc (vlax-get lay 'description)) (setq lst (cons (list lcol lname ldesc) lst)) ) (setq lst (vl-sort lst '(lambda (x y) (< (cadr x)(cadr y))))) (setq pt (vlax-3d-point (getpoint "\npick a point for table "))) (setq doc (vla-get-activedocument (vlax-get-acad-object) )) (if (= (vla-get-activespace doc) 0) (setq curspc (vla-get-paperspace doc)) (setq curspc (vla-get-modelspace doc)) ) (setq numrows 3) (setq numcolumns 3) (setq rowht 5) (setq colwidth 50) (setq objtable (vla-addtable curspc pt numrows numcolumns rowht colwidth)) (vla-settext objtable 0 0 "Layer Details") (vla-settext objtable 1 0 "Color Numb. & Linetype") (vla-settext objtable 1 1 "Layer Name") (vla-settext objtable 1 2 "Layer description") (setq objtable (vlax-ename->vla-object (entlast))) (setq rowht (vla-getrowheight objtable 1)) (vla-put-regeneratetablesuppressed objtable :vlax-true) (setq row 2) (foreach lay lst (princ (cadr lay)) (vla-settext objtable row 0 (strcat (rtos (car lay) 2 0) " ")) (vla-setcellalignment objtable row 0 acMiddleRight) (vla-settext objtable row 1 (cadr lay)) (if (= (caddr lay) "") (setq desc (cadr lay)) (setq desc (caddr lay)) ) (vla-settext objtable row 2 desc) (setq pts (vlax-safearray->list (vlax-variant-value (VLA-GETCELLEXTENTS objtable row 0 :vlax-false)))) (setq pt1 (list (nth 0 pts)(nth 1 pts) 0.0)) (setq pt2 (list (nth 6 pts)(nth 7 pts) 0.0)) (setq vdist (/ (- (cadr pt1) (cadr pt2)) 2.0)) (setq pt1 (mapcar '+ pt1 (list 5.0 (- vdist) 0.0))) (setq pt2 (list (nth 3 pts)(nth 4 pts) 0.0)) (setq pt2 (mapcar '+ pt2 (list (- 7.0) (- vdist) 0.0))) (entmake (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt2) (cons 8 (cadr lay)))) (vla-insertrows objtable (setq row (1+ row)) rowht 1) ) (vla-put-regeneratetablesuppressed objtable :vlax-false) (setvar 'osmode oldsnap) (princ) ) (c:mktablay)
- Last week
-
As I said previously "I am sure given that import a pdf and then re email the result back to you could be done by a friend as it takes like one minute." For that dwg maybe a few minutes, as suggested by @SLW210 do small bits at a time. @CHAKRADHAR It may cost you a little bit like cost of a cup of coffee. I can not help, Where are you in the world helps with time differences ? Some one here may be able to help. Did you contact ZWCAD, I know Bricscad are pretty good at listening to requests for missing functions.
-
nelsonm started following Civil Drafting with AutoCAD Project-Civil Drafting with AutoCAD Project
-
Civil Drafting with AutoCAD Project-Civil Drafting with AutoCAD Project
nelsonm posted a topic in Student Project Questions
Hi, I'm a student from Pen Foster College and I have a trouble with this Project. I would like to get some help. For this part: Drafting the Existing Site Plan (Sheet 1): "Now, you need to figure out where the contour intervals cross the grid lines between each spot elevation. Create contours at 10′ intervals for just the 100′–180′ contour lines. You can estimate where a contour line intersects a grid line using interpolation. You can interpolate the position of the contours by estimating between the known locations of the spot elevations. You may find it quicker to set up a spreadsheet to help you calculate all the locations." Can someone guide me to get started with this part? please 3. Civil Engineering Drafting.pdf -
deniscasillas joined the community
-
Segment Copy of a Region (cleaning request)
ScottMC replied to ScottMC's topic in AutoLISP, Visual LISP & DCL
Here's my latest region segment copier.. (defun TLENGTH (/ di ent n pt1 pt2 sel) ;; https://ukcommunity.arkance.world/hc/en-us/articles/21550748461458-AutoCAD-Tip-Using-AutoLisp-to-calculate-total-length-of-multiple-objects (vl-load-com) ;; NotLoaded/Patrick_35/Tot-v1.03 ; (if (ssget '((0 . "LINE,POLYLINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE"))) (progn (setq di 0) (vlax-for ent (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))) (cond ((member (vla-get-objectname ent) '("AcDbLine")) ;; "AcDb3dPolyline" "AcDbPolyline" (setq di (+ di (vla-get-Length ent))) ;; <- not a2k op for /\ poly?? ) ((eq (vla-get-objectname ent) "AcDbArc") (setq di (+ di (vla-get-ArcLength ent))) ) ((eq (vla-get-objectname ent) "AcDbCircle") (setq di (+ di (vla-get-Circumference ent))) ) ((member (vla-get-objectname ent) '("AcDbSpline" "AcDbEllipse")) (setq di (+ di (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)))) ) ) ) ) (princ (strcat (rtos di 2 4) " :Len")) (princ) ) ;;// ----------------------------------------------------------------------------------------------------------- (defun c:crs (/ *error* ss ss1 ssm ssp cec doc lastent html) ;; AI.. https://www.google.com/search?q=copy+region+edge+segment%2C+autolisp&client=firefox-b-1-e&hs=LJSp&sca_esv=28d160b4388e87a1&biw=1143&bih=530&ei=t2enadf8OfXIp84PyJ69kA8&ved=0ahUKEwiXtPqy6oSTAxV15MkDHUhPD_I4ChDh1QMIEQ&uact=5&oq=copy+region+edge+segment%2C+autolisp&gs_lp=Egxnd3Mtd2l6LXNlcnAiImNvcHkgcmVnaW9uIGVkZ2Ugc2VnbWVudCwgYXV0b2xpc3AyCBAAGIAEGKIEMgUQABjvBTIFEAAY7wUyBRAAGO8FMgUQABjvBUjeM1C3D1iRLnABeACQAQCYAYgIoAHMC6oBBzAuNC43LTG4AQPIAQD4AQGYAgagApcNwgIIEAAYsAMY7wXCAgoQIRigARjDBBgKmAMAiAYBkAYFkgcHMS40LjYtMaAH0BCyBwcwLjQuNi0xuAffDMIHBzItMS4zLjLIB2uACAA&sclient=gws-wiz-serp (princ "\n ** wcs Copy Region Segment: <oops> ") ;; https://www.cadtutor.net/forum/topic/99013-segment-copy-of-a-region-cleaning-request/#findComment-678508 (setvar 'cmdecho 0) (vl-load-com) ;; (defun *error* ( msg ) (setvar 'cmdecho 0) ;; (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (if msg (prompt (strcat "\n" msg))) (if (= fin 1) (command "_.pasteclip" "0,0,0")) ;; restores region if incomplete/esc.. (setvar 'cecolor cec) ;; ch copied to prev (setvar 'cursorsize 100) (setvar 'osmode posm) (setvar 'nomutt 0) (setvar 'cmdecho 1) (princ) ) (setq posm (getvar 'osmode)) ;; better without end/with.nea (setvar 'osmode (boole 7 (getvar 'osmode) 512)) ;; adds <nea> (setvar 'osmode (boole 2 (getvar 'osmode) 1)) ;; removes <end> (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) ;; eases oops's/undo ;; clears clipbrd Roy_043;; https://www.cadtutor.net/forum/topic/62075-copy-to-clipboard/#findComment-512255 (setq html (vlax-create-object "HTMLFile")) (vlax-invoke (vlax-get (vlax-get html 'ParentWindow) 'ClipboardData) 'SetData "Text" "") (vlax-release-object html) (setq fin 1) (setq cec (getvar 'cecolor)) (setvar 'nomutt 1) ;; bypass ssget 'select prompt ;;// ----------------------------------------------------------------------------------------------------------- ;; init selection (while ;; loop/proof/select 1 region (not (setq ss (ssget ":S" '((0 . "REGION"))))) ) (command "_.copybase" "0,0" ss "") ;; copy region to clipbrd (command "chprop" ss "" "c" 142 "") ;; change color (setq LastEnt (entlast)) ;; Set LastEnt to last entity.;;; !! beginning of entity storage \/ (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (command "_.explode" ss) ;; make segs accessible (setq SS1 (ssadd)) ;; create a blank selection set 'SS1 for later use ;; or add to an existing one., (while (setq LastEnt (entnext LastEnt)) ;; Sets LastEnt to first entity name (ssadd LastEnt SS1) ;; adds LastEnt to new 'SS1 selection set, to erase later !! ) (while T ;; loop to multi-copy of exploded region.. <actually anything> (princ "\nSelect Region Segment to Copy ") (setvar 'cursorsize 1) ;; get cursor.lines out.of.site (initget 1) ;; added to filter but, 'rt.clk < pastes but as.from base zero > ;; usable (defun loop ( / ) ;; select.validator (and ;; when ssp+ssm happen.. (setq ssp (getpoint)) ;; get coords for copy/basepoint <----------------------- (if (not (setq ssm (ssget ssp '((0 . "*POLYLINE,ARC,CIRCLE,LINE,ELLIPSE"))))) ;; pick on segment [at 'ssp] (progn (princ "\rSelect Region Segment to Copy ")(loop)) ) ;; /\ NOT CATCHING: ITEMS.NOT.FROM.'EXPLODE' () ;; BUT STILL FUNCTIONS [COPIES] ANY.. ) ;; end of and ) ;; end of if (loop) ;; restart if not 'ssp type or open pic /\ (command "_.copy" ssm) ;; begin move a segment copy (setvar 'nomutt 1) ;; manual prompt (command "" ssp) ;; coords selected in /\ 'loop removed: (princ "\nSpecify Basepoint: ") (command "" "\\") (princ "\nSpecify Destination: ") (command "\\") ;; +move to (setvar 'nomutt 0) ;; turn prompt on (TLENGTH) (command "chprop" "_L" "" "c" cec "") ;; ch copied color to bylayer ) ;; end of while loop (setvar 'cursorsize 100) ;; set 'cross.hair.size' to normal (setvar 'nomutt 0) ;; turn prompt on (command "_.erase" ss "") ;; region copied/erasure (command "_.erase" SS1 "") ;; erases exploded (saved) selection set -|100 ; moved within while /\ (command "chprop" "_L" "" "c" cec "") ;; ch copied color to bylayer (command "_.pasteclip" "0,0") ;; re.places original copied region -|86 (setq fin nil) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) ;; eases oops's/undo (setvar 'cecolor cec) ;; resets color (setvar 'cursorsize 100) (setvar 'osmode posm) (setvar 'nomutt 0) (setvar 'cmdecho 1) (*error* nil) (princ) ) -
I have no issues turning the geometry text to MText in AutoCAD. No, you can select a range for the closest matching font, you can have a lot of fonts loaded or just a few, and it can do small or large selections, but better results are from small selections. I have already fixed the OP's file, easy peasy in AutoCAD.
-
Lisa123456789 joined the community
-
@SLW210 just import the sample File.pdf you will see the SHX text its pretty obvious. No pdfshxtext in Bricscad V25 lots of other pdf settings. I am pretty sure I have ran that command it asks for the text font to be searched for like ISOCP.shx and so on.
-
Can do the read excel bit but need a csv or Excel. making the table is not a problem. Have somewhere draw a line in a table or make a cell a full solid color, the other is add a block to a table. Bit busy at moment but maybe soon something. It may be easier to just read all current layer details as a step 2.
-
Michael Navrátil joined the community
-
AutoCAD has PDFSHXTEXT to convert the vector lines/arcs that once were SHX texts back to texts. Post the converted PDF file from ZWCAD. Sounds like you need to use something better than ZWCAD if it isn't capable of doing what you need. This still goes back to you need to use TTFs.
-
Jake L joined the community
-
CAN U GIVE CONVERTED FILE THAT U HAVE CONVERTED
-
-
I HAVE 2026 ZWCAD SIR
-
Thanks!! it's working fine. It's okay if it's not exactly the same from mine but as long as it can generate the table it's fine. saved me a lot of time.
-
I am not good as the others but try this. It will build what you want to achieve but not exactly as what was shown in the image. Maybe other can improve the code. (defun c:LayerLegend (/ doc lays lay laylist layname laycolor laydesc pt x y starty rowH txtH headH colHT col1 col2 col3 totalH legendBlock w) (defun GetTextWidth (txt height / doc ms txtObj minp maxp w) (if (or (not txt) (= txt "")) 0 (progn (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq ms (vla-get-ModelSpace doc)) ;; create temp text off-screen (setq txtObj (vla-AddText ms txt (vlax-3d-point -1000 -1000 0) height)) ;; initialize safearrays (setq minp (vlax-make-safearray vlax-vbDouble '(0 . 2))) (setq maxp (vlax-make-safearray vlax-vbDouble '(0 . 2))) ;; get bounding box safely (vl-catch-all-apply '(lambda () (vla-GetBoundingBox txtObj 'minp 'maxp) )) ;; width in X direction (setq w (abs (- (vlax-safearray-get-element maxp 0) (vlax-safearray-get-element minp 0)))) ;; delete temp text (vla-Delete txtObj) w ) ) ) (vl-load-com) (setq rowH 8.0) (setq txtH 2.0) (setq headH 2.5) (setq colHT 1.0) (setq col1 35.0) ;; fixed column 1 width (setq col2 50.0) ;; fixed column 2 width (setq col3 65.0) ;; fixed column 3 width (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq lays (vla-get-Layers doc)) (setq laylist '()) (vlax-for lay lays (setq layname (vla-get-name lay)) (setq laydesc (if (vlax-property-available-p lay 'Description) (vla-get-description lay) "")) ;; Skip 0, Defpoints, XREF (if (and (/= layname "0") (/= (strcase layname) "DEFPOINTS") (not (vl-string-search "|" layname))) (progn (setq laycolor (vla-get-color lay)) (setq laylist (cons (list layname laycolor laydesc) laylist)) ) ) ) (setq laylist (vl-sort laylist '(lambda (a b) (< (strcase (car a)) (strcase (car b)))) ) ) (if (setq legendBlock (tblsearch "BLOCK" "LAYERLEGEND_MARK")) (command "_.erase" "B" "LAYERLEGEND_MARK" "") ) (setq pt (getpoint "\nPick insertion point: ")) (setq x (car pt)) (setq y (cadr pt)) (setq starty y) (setq totalH (* rowH (+ (length laylist) 1))) (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list x starty 0)) (cons 11 (list (+ x col1 col2 col3) starty 0)))) (entmakex (list '(0 . "TEXT")(cons 8 "0") (cons 10 (list (+ x 3) (- y 5) 0)) (cons 40 headH) (cons 1 "COLOR NUMBER"))) (entmakex (list '(0 . "TEXT")(cons 8 "0") (cons 10 (list (+ x col1 3) (- y 5) 0)) (cons 40 headH) (cons 1 "LAYER NAME"))) (entmakex (list '(0 . "TEXT")(cons 8 "0") (cons 10 (list (+ x col1 col2 3) (- y 5) 0)) (cons 40 headH) (cons 1 "DESCRIPTION"))) ;; header bottom line (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list x (- y rowH) 0)) (cons 11 (list (+ x col1 col2 col3) (- y rowH) 0)))) (setq y (- y rowH)) (foreach L laylist (setq layname (nth 0 L)) (setq laycolor (nth 1 L)) (setq laydesc (nth 2 L)) ;; Color number text (1 mm) on its layer (entmakex (list '(0 . "TEXT") (cons 8 layname) (cons 10 (list (+ x 3) (+ y -2.2) 0)) (cons 40 colHT) (cons 1 (itoa laycolor)))) ;; Sample line on its layer (entmakex (list '(0 . "LINE") (cons 8 layname) (cons 10 (list (+ x 3) (- y 3) 0)) (cons 11 (list (+ x col1 -3) (- y 3) 0)))) ;; Layer name text on its layer (entmakex (list '(0 . "TEXT") (cons 8 layname) (cons 10 (list (+ x col1 3) (- y 4) 0)) (cons 40 txtH) (cons 1 layname))) ;; Description text (Layer 0) (entmakex (list '(0 . "TEXT") (cons 8 "0") (cons 10 (list (+ x col1 col2 3) (- y 4) 0)) (cons 40 txtH) (cons 1 laydesc))) ;; Row horizontal line (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list x (- y rowH) 0)) (cons 11 (list (+ x col1 col2 col3) (- y rowH) 0)))) (setq y (- y rowH)) ) (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list x starty 0)) (cons 11 (list x (- starty totalH) 0)))) (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list (+ x col1) starty 0)) (cons 11 (list (+ x col1) (- starty totalH) 0)))) (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list (+ x col1 col2) starty 0)) (cons 11 (list (+ x col1 col2) (- starty totalH) 0)))) (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list (+ x col1 col2 col3) starty 0)) (cons 11 (list (+ x col1 col2 col3) (- starty totalH) 0)))) (princ) )
-
I tried asking AI but unfortunately it's not working. ;;; ------------------------------------------------------------------------ ;;; Layer Table Builder ;;; Creates a table of all layers with a color swatch above a sample line, ;;; plus Layer Name and Layer Description columns. ;;; Text height is targeted at 2 mm on paper (asks for scale if in Model Space). ;;; ;;; Tested: AutoCAD 2015+ (VLIDE/Visual LISP) ;;; ------------------------------------------------------------------------ (vl-load-com) ;; ---------------------------- ;; Helpers ;; ---------------------------- (defun _acad-doc () (vla-get-ActiveDocument (vlax-get-acad-object))) (defun _cur-space (doc / ) ;; Returns current space object (Model or Paper) based on CTAB. (if (= (getvar "CTAB") "Model") (vla-get-ModelSpace doc) (vla-get-PaperSpace doc) ) ) (defun _ensure-layer (doc layname color / laycol lays colobj) ;; Ensure a layer exists. Color is ACI index or nil (no change). (setq lays (vla-get-Layers doc)) (if (not (tblsearch "LAYER" layname)) (progn (vla-Add lays layname) (if color (vla-put-Color (vla-Item lays layname) color)) ) ) (vla-Item lays layname) ) (defun _3dpt (p) (vlax-3d-point p)) (defun _add-mtext (spc ins width str h / obj) (setq obj (vla-AddMText spc (_3dpt ins) width str)) (vla-put-Height obj h) obj ) (defun _ent-solid-rect (layer pmin pmax / x1 y1 x2 y2) ;; pmin = (x1 y1), pmax = (x2 y2) (setq x1 (car pmin) y1 (cadr pmin) x2 (car pmax) y2 (cadr pmax)) (entmakex (list (cons 0 "SOLID") (cons 8 layer) (cons 10 (list x1 y2 0.0)) (cons 11 (list x2 y2 0.0)) (cons 12 (list x2 y1 0.0)) (cons 13 (list x1 y1 0.0)) ) ) ) (defun _ent-line (layer p1 p2) (entmakex (list (cons 0 "LINE") (cons 8 layer) (cons 10 (list (car p1) (cadr p1) 0.0)) (cons 11 (list (car p2) (cadr p2) 0.0)) ) ) ) (defun _ent-lwpoly (layer pts closed / n data) ;; pts: list of (x y). closed: T/NIL (setq n (length pts)) (setq data (append (list (cons 0 "LWPOLYLINE") (cons 8 layer) (cons 90 n) (cons 70 (if closed 1 0)) ) (apply 'append (mapcar '(lambda (p) (list (cons 10 p) (cons 40 0.0) (cons 41 0.0) (cons 42 0.0))) pts ) ) ) ) (entmakex data) ) (defun _safe-str (x) (cond ((null x) "") ((= x "") "") (t x) ) ) (defun _layer-desc (vlaLayerObj / desc) (vl-catch-all-apply '(lambda () (setq desc (vla-get-Description vlaLayerObj)) ) ) (_safe-str desc) ) (defun _is-xref-or-defpoints (vlaLayerObj) (or (vla-get-IsXRefDependent vlaLayerObj) (wcmatch (strcase (vla-get-Name vlaLayerObj)) "*|*") ;; xref-style name (= (strcase (vla-get-Name vlaLayerObj)) "DEFPOINTS") ) ) (defun _sort-ci (lst) (vl-sort lst (function (lambda (a b) (< (strcase a) (strcase b))) ) ) ) ;; ---------------------------- ;; Main command ;; ---------------------------- (defun c:LAYERTABLE (/ doc spc oldlay ins inc-xref sortAZ spaceChoice sden mmPerUnit th ;; computed text height in current space pad rowH wA wB wC tblLayer colLayer layers laycol i n y0 x0 xA xB xC xR hdrH titleH curtab) (setq doc (_acad-doc)) (setq spc (_cur-space doc)) (setq oldlay (getvar "CLAYER")) (setq curtab (getvar "CTAB")) ;; ---- Options & prompts ---- (princ "\n=== Layer Table ===") (setq inc-xref (getkword "\nInclude XREF/DEFPOINTS layers? [Yes/No] <No>: ")) (if (null inc-xref) (setq inc-xref "No")) (setq sortAZ (getkword "\nSort layers A->Z? [Yes/No] <Yes>: ")) (if (null sortAZ) (setq sortAZ "Yes")) (setq spaceChoice (getkword (strcat "\nPlace in which space? [Current(" curtab ")/Model/Paper] <Current>: "))) (cond ((or (null spaceChoice) (= (strcase spaceChoice) "CURRENT")) ;; use current space ) ((= (strcase spaceChoice) "MODEL") (setq spc (vla-get-ModelSpace doc)) ) ((= (strcase spaceChoice) "PAPER") (setq spc (vla-get-PaperSpace doc)) ) ) ;; Scale: 2 mm text on paper -> convert to current space height ;; Ask: viewport scale denominator (1:xxx), default 1 when in Paper space, else 100 (setq sden (cond ((= spc (vla-get-PaperSpace doc)) ;; Paper space (getint "\nViewport scale denominator (1:xxx). Paper space -> use 1. <1>: ")) (t (getint "\nViewport scale denominator (1:xxx). Model space example: 100 for 1:100 <100>: ")) ) ) (if (= spc (vla-get-PaperSpace doc)) (if (or (null sden) (< sden 1)) (setq sden 1)) (if (or (null sden) (< sden 1)) (setq sden 100)) ) ;; Ask: how many millimeters per drawing unit (unit conversion). ;; Common: mm drawing -> 1; meter drawing -> 1000; inch -> 25.4; foot -> 304.8 (setq mmPerUnit (getreal "\nMillimeters per drawing unit? (mm=1, m=1000, in=25.4, ft=304.8) <1>: ")) (if (or (null mmPerUnit) (<= mmPerUnit 0.0)) (setq mmPerUnit 1.0)) ;; Text height in current space units: ;; th = (2 mm * scale denominator) / (mm per unit) (setq th (/ (* 2.0 sden) mmPerUnit)) ;; Layout metrics (setq pad (* 0.5 th)) ;; inner padding (setq rowH (* 6.0 th)) ;; row height (setq hdrH (* 6.5 th)) ;; header row height (setq titleH (* 1.1 th)) ;; header text height ;; Column widths (scaled with text height) ;; Col A (swatch+line), Col B (Layer Name), Col C (Description) (setq wA (* 12.0 th) wB (* 40.0 th) wC (* 70.0 th) ) ;; Target layers for graphics/text (setq tblLayer "LAYER_TABLE") (setq colLayer "LAYER_TABLE") ;; grid + text layer (_ensure-layer doc tblLayer 7) ;; Pick insertion point (top-left) (setq ins (getpoint "\nPick top-left corner of the table: ")) (if (null ins) (progn (princ "\n*Cancelled*")(exit))) (setq x0 (car ins)) (setq y0 (cadr ins)) (setq xA (+ x0 wA)) (setq xB (+ xA wB)) (setq xC (+ xB wC)) (setq xR xC) ;; right edge ;; Collect layer info (setq layers '()) (vlax-for L (vla-get-Layers doc) (setq lname (vla-get-Name L)) (if (or (not (wcmatch (strcase inc-xref) "NO")) (not (_is-xref-or-defpoints L)) ) (setq layers (cons (list lname L) layers)) ) ) (if (wcmatch (strcase sortAZ) "YES") (setq layers (mapcar '(lambda (p) (list (car p) (cadr p))) (vl-sort layers (function (lambda (a b) (< (strcase (car a)) (strcase (car b)) ))) ) ) ) ) (setq n (length layers)) (if (= n 0) (progn (princ "\nNo layers found after filtering.")(exit))) ;; ---------------------------- ;; Draw header grid ;; ---------------------------- ;; Outer border (_ent-lwpoly colLayer (list (list x0 y0) (list xR y0) (list xR (- y0 hdrH)) (list x0 (- y0 hdrH))) T) ;; Header verticals (_ent-line colLayer (list xA y0) (list xA (- y0 hdrH))) (_ent-line colLayer (list xB y0) (list xB (- y0 hdrH))) ;; Header text (_add-mtext spc (list (+ x0 pad) (- y0 pad)) (- wA (* 2.0 pad)) "Color + Line" titleH) (_add-mtext spc (list (+ xA pad) (- y0 pad)) (- wB (* 2.0 pad)) "Layer Name" titleH) (_add-mtext spc (list (+ xB pad) (- y0 pad)) (- wC (* 2.0 pad)) "Description" titleH) ;; ---------------------------- ;; Draw rows ;; ---------------------------- (setq i 0) (repeat n (setq ytop (- y0 hdrH (* i rowH))) (setq ybot (- ytop rowH)) ;; Row border (_ent-lwpoly colLayer (list (list x0 ytop) (list xR ytop) (list xR ybot) (list x0 ybot)) T) ;; Row verticals (_ent-line colLayer (list xA ytop) (list xA ybot)) (_ent-line colLayer (list xB ytop) (list xB ybot)) ;; Data for this layer (setq lname (car (nth i layers))) (setq Lobj (cadr (nth i layers))) (setq ldesc (_layer-desc Lobj)) ;; --- Column A: Color Swatch (SOLID) above Sample Line --- (setq cellLeft x0) (setq cellRight xA) (setq cellTop ytop) (setq cellBot ybot) (setq swPad pad) (setq swW (- wA (* 2.0 swPad))) ;; swatch width (setq swH (* 1.6 th)) ;; swatch height (setq swX1 (+ cellLeft swPad)) (setq swX2 (+ swX1 swW)) (setq swY1 (- cellTop swPad)) ;; top-down build (setq swY2 (- swY1 swH)) ;; swatch bottom ;; SOLID swatch on the layer (_ent-solid-rect lname (list swX1 swY2) (list swX2 swY1)) ;; Sample line below swatch, centered (setq lnW (* 0.85 swW)) (setq lnX1 (+ cellLeft (/ (- wA lnW) 2.0))) (setq lnX2 (+ lnX1 lnW)) (setq lnY (- swY2 (* 0.7 th))) ;; a bit below the swatch (_ent-line lname (list lnX1 lnY) (list lnX2 lnY)) ;; --- Column B: Layer Name (MTEXT) --- (_add-mtext spc (list (+ xA pad) (- ytop pad)) (- wB (* 2.0 pad)) lname th) ;; --- Column C: Layer Description (MTEXT) --- (_add-mtext spc (list (+ xB pad) (- ytop pad)) (- wC (* 2.0 pad)) (if (= ldesc "") "<no description>" ldesc) th) (setq i (1+ i)) ) ;; Restore layer & finish (setvar "CLAYER" oldlay) (princ (strcat "\nLayer table created. Rows: " (itoa n) ".")) (princ) ) (princ "\nCommand loaded: LAYERTABLE — Create a layer table with color swatches and lines.") (princ)
-
Yes this is exactly what I need
