Leaderboard

Another slight update the report at the end should give a list with 4 details per plot Paper Size, Orientation, LL Coord, UR Coord Limitation is going to be in the larger plot sizes if there is a polyline the same length as a smaller paper size with 4 verticies and closed at the end not sure if that will ever be an issue? (defun c:test ( / MySS MyPoly MyEnt MyPolyLength PtsList LL1 LL2 UR1 UR2 Orientation Paper BordersCoords) (setq BorderSizeList (list ;Perimeter : Paper Size Name (P) Paper Size name (L) (cons 39 (list "ANSI A (8.50 x 11.00 INCHES)" "ANSI A (11.00 x 8.50 INCHES)" )) (cons 56 (list "ANSI B (11.00 x 17.00 INCHES)" "ANSI B (17.00 x 11.00 INCHES)" )) (cons 78 (list "ANSI C (17.00 x 22.00 INCHES)" "ANSI C (22.00 x 17.00 INCHES)" )) (cons 112 (list "ANSI D (22.00 x 34.00 INCHES)" "ANSI D (22.00 x 34.00 INCHES)" )) )) (vl-load-com) (defun curvelength ( ent / )(vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))) ;; Lee Mac Suggestion (defun LM:MAssoc ( key lst / pair return ) ; Get 'key' values from dotted pair lists (while (setq pair (assoc key lst)) (setq return (cons (cdr pair) return) lst (cdr (member pair lst))) ) (reverse return) ) (setq MySS (ssget '((0 . "LWPOLYLINE") (-4 . "<OR") (90 . 4) (90 . 5) (-4 . "OR>")))) ; 4 or 5 points polylines (setq acount 0) ; A counter (while (< acount (sslength MySS)) ; Loop through Selection set MySS (setq MyPoly (ssname MySS acount)) ; nth item in MySS entity name (setq MyEnt (entget MyPoly)) ; nth item in MySS entity description (setq MyPolyLength (curvelength MyPoly)) ; Length of the polyline (setq fortytwomax 0) (foreach n (lm:MAssoc 42 MyEnt) (setq fortytwomax (max (abs n) fortytwomax))) ;Get maximum Polyline segment arc radius (if (and ; If: (or ; Poplyline is closed rectangle: (equal (assoc 10 MyEnt) (assoc 10 (reverse MyEnt)) 0.05 ) ; start / end point equal +/- 0.05 (equal (assoc 70 MyEnt) '(70 . 1)) ; 'closed' polyline ) ; endor (= 0 fortytwomax) ; Max segment radius 0: Straight lines only (or ; And polyline Length is border length (equal MyPolyLength 39 0.4) ; +/- 10% (equal MyPolyLength 56 0.6) ; +/- 10% (equal MyPolyLength 112 1.15) ; +/- 10% ) ) ; end and (progn (setq PtsList (lm:MAssoc 10 MyEnt)) ; Get list of polyline points (setq LL1 (car (car PtsList)))(setq LL2 (cadr (car PtsList))) ; Work out lower left / upper right coordinates (setq UR1 (car (car PtsList)))(setq UR2 (cadr (car PtsList))) (foreach n PtsList (setq LL1 (min (car n) LL1)) (setq LL2 (min (cadr n) LL2)) (setq UR1 (max (car n) UR1)) (setq UR2 (max (cadr n) UR2)) ) (if (< (- UR1 LL1) (- UR2 LL2)) (setq Orientation 0)(setq Orientation 1)) (setq Paper (nth Orientation (cdr (assoc MyPolyLength BorderSizeList)))) (if (< (- UR1 LL1) (- UR2 LL2)) (setq Orientation "P")(setq Orientation "L")) (setq BordersCoords (cons (list Paper Orientation (list LL1 LL2) (list UR1 UR2)) BordersCoords)) ; make list of all border coordiantes (redraw MyPoly 3) ; remove this line if happy with selection ) ;end progn ) ; end if (setq acount (+ acount 1)) ) (princ (length BordersCoords)) (princ " Borders Found. ") (getstring "\nHit Enter to remove highlights") ; remove this line if happy with selection (command "regen") ; remove this line if happy with selection (princ "\n Coordinates List: Ansi-Papersize Orientation (LL Cord) (UR Coord) ") (princ "\n")(princ BordersCoords) (princ) )

as an update, i fixed the code using VLAX-INVOKE method to create the mleader: it's friday...give me a break (defun LM:getdynpropvalue (blk prp) (setq prp (strcase prp)) (vl-some '(lambda (x) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'Value))) (vlax-invoke blk 'GetDynamicBlockProperties))) (defun c:swtest () (setq blockName (car (entsel "\nSelect Block: "))) (if (and blockName (eq (cdr (assoc 0 (entget blockName))) "INSERT")) (progn (setq vlaBlock (vlax-ename->vla-object blockName)) (setq SW_LENGTH (LM:getdynpropvalue vlaBlock "SW_LENGTH")) (if SW_LENGTH (progn (setq textString (strcat "SW_LENGTH: " (rtos SW_LENGTH 2 2))) (princ (strcat "\n" textString)) (if (setq ins (getpoint "\nSpecify start point for MLeader: ")) (progn (setq endPoint (getpoint "\nSpecify end point for MLeader: " ins)) (setq curlay (getvar "CLAYER")) (setvar 'CMDECHO 0) (command "_.undo" "_group") (setvar 'CLAYER "S - TEXT") (command "CMLEADERSTYLE" "NORMAL - SW") (setvar 'CMDECHO 1) (initcommandversion) ;; Creating MLeader using vlax-invoke method (setq mleaderObj (vlax-invoke (vlax-get (vla-get-ActiveDocument (vlax-get-acad-object)) (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace)) 'AddMLeader (append ins endPoint) 0)) (vla-put-TextString mleaderObj textString) (setvar 'CMDECHO 0) (command "CMLEADERSTYLE" "Normal") (command "_.LAYER" "_SET" curlay "") (command "_.undo" "_end") (setvar 'CMDECHO 1) (princ "MLeader with SW_LENGTH created.")) (alert "Insertion point not specified!"))) (alert "SW_LENGTH attribute not found!"))) (alert "Selected entity is not a block!")) (princ))

See this article from Autodesk. Why write code when you can use tools you already have? Welcome to the forum!

I had similiar request as OP and I confirm that this solution by Lee Mac works great in 2024.

Noticed a type-o Steven (cons 78 (list "ANSI C (17.00 x 22.00 INCHES)" "ANSI B (22.00 x 17.00 INCHES)" )) to (cons 78 (list "ANSI C (17.00 x 22.00 INCHES)" "ANSI C (22.00 x 17.00 INCHES)" ))

The problem isn't the way its coded, or with using the temp folder. I think its a nice way of making a dialog tbh. The problem is here: (cond [...] ( (set_tile "res" (rtos (- x y) 2))) ( (set_tile "res2" (rtos (- x z) 2))) ) The first one returns true, and stops the cond. If you want two actions, you want to put them together in a cond-item. Like so: (cond [...] (t (set_tile "res" (rtos (- x y) 2)) (set_tile "res2" (rtos (- x z) 2)) ) )

You're right mhupp, the mapss function wouldn't give an error in the "test command" pkenewell posted, but we do want these functions to work in most situations without throwing unexpected errors. Probably good to check if ss is really a pickset as well: (defun mapss (ss func) (if (= 'PICKSET (type ss)) (mapcar func (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)) ) ) ) ) Just to note, it is best to only use the mapss function when you need the output of the functions to be returned in a list. Otherwise your foreach loop or the foreach-ss function posted earlier would be preferable.

You can adapt this at your convenient ((lambda ( / flag def_lay nam_lay js) (setq flag T) (while (setq def_lay (tblnext "LAYER" flag)) (setq nam_lay (cdr (assoc 2 def_lay)) flag nil) (cond ((setq js (ssget "_X" (list (cons 8 nam_lay)))) ;(command "_.-wblock" (strcat (getvar "dwgname") "$" nam_lay) "" "*0.0,0.0,0.0" js "") (command "_.dxfout" (strcat (getvar "dwgprefix") (getvar "dwgname") "$" nam_lay) "_version" "2000" "_objects" js "" "16") ) ) ) (prin1) ))

My way (defun convert_str2mil (str2cnv flag / l_str n l_nw) (setq l_str (if flag (reverse (vl-string->list str2cnv)) (vl-string->list str2cnv)) n 1) (while l_str (if (zerop (rem n 3)) (setq l_nw (cons 46 (cons (car l_str) l_nw))) (setq l_nw (cons (car l_str) l_nw)) ) (setq l_str (cdr l_str) n (1+ n)) ) (vl-list->string (if (not flag) (reverse l_nw) l_nw)) ) (defun C:LP ( / PNT1 P1X P1Y STDX STDY PTXT mantisse p_decimal) (setq PNT1 (getpoint "\nPick coordinate point: ")) (setq P1X (car pnt1)) ;x coord (setq P1Y (cadr pnt1)) ;y coord (setq STDX (strcat (convert_str2mil (rtos (setq mantisse (fix P1X)) 2 0) T) "," (substr (convert_str2mil (substr (rtos (setq p_decimal (- P1X (fix P1X))) 2) 3) nil) 1 3) ) ) (setq STDY (strcat (convert_str2mil (rtos (setq mantisse (fix P1Y)) 2 0) T) "," (substr (convert_str2mil (substr (rtos (setq p_decimal (- P1Y (fix P1Y))) 2) 3) nil) 1 3) ) ) (if (eq (substr STDX 1 1) ".") (setq STDX (substr STDX 2))) (if (eq (substr STDY 1 1) ".") (setq STDY (substr STDY 2))) (setq PTXT (getpoint "\nPick text location: ")) (command "_.LEADER" PNT1 PTXT "" (strcat "N=" STDY "\nE= " STDX "") "") (princ) )

Dear Mhupp This works for me !!!! many many thanks...... really do appreciate your effort and your genius !!!! and a big thanks to everyone who put their brains into this you guys are the best !!!! Harsh

Can you provide more images and an description of what you're trying to do? It's a little difficult to understand what I'm looking at in that image.

Did you look at the Bolt I posted has different sizes includes a nut and can be stretched that is what a Dynamic block is about much easier than lisp to use. Steven P yes there are rules about Bolt head/nut sizes that are relevant to bolt size, for end elevations there are 2 views as you can view across flats or with edge facing which is lightly wider. Look at a hexagon polygon. If I remember correct G is 2xDia.

@Nikon Thank you! According to your images, I think I have answered your request although I am not in the trade (if I understood correctly it concerns steels and I know nothing about it). So this accepts polylines with 4 or 2 vertices, as well as lines and the dimensions follow the direction of creation of the entities. For the VLX, we can't do anything because it is compiled. Only the creator who owns the sources can correct it. ntt(bis).lsp

Just tested using the full keywords and it works like a charm... Thank you again for your time and patience.

only real time is use entlast is in instances like @Steven P said or when i have to build a selection set after modifying/creating a bunch of stuff inside a lisp and don't want to prompt the user to select them again. (setq SS (ssadd)) ;how to create a blank selection set (setq LastEnt (entlast)) ;set right before you create objects. you want to either add to a selection set or track while in a lisp (while (setq LastEnt (entnext LastEnt)) ;after entities are created this will add them to a selection set. (ssadd EntLst SS) ;a blank selection set or existing selection set is needed. )

This is how I process a selection set. will generate a list of entity names for the selection (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ;code here will repeat for each each entity name in list ) A few years ago stumbled across what pkenewell posted to instead make a vla-object list (foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) ;code here will repeat for each each vla-object name in list ) ent and obj don't need to be declared since they are only temp while in the foreach loop. -edit @dexus The (vl-remove-if 'listp is to remove the point or points used when making the selection set this isn't needed when ssget with "_X" option is used. Since a pick point isn't generated for those selection sets.

OP, have you tested the code I provided here : https://www.cadtutor.net/forum/topic/85374-why-would-entlast-not-be-getting-the-unioned-entity-in-this-code/?do=findComment&comment=640320 It seems that you avoid my inputs... It should do what should, as I also avoided (entlast)...

Yes, that's right. I try to avoid entlast if I can unless it is in the line straight after I have created an entity.

It works for me, even the code from first post, with changed ss2 to ss1 of course. I didn't quite understand what error are you getting and where? Is this what you want as result? Image attached, red are the difference areas. Also I edited main defun a bit, its better to use real number for area comparison, you can adjust the tolerance (defun c:ac1 () (setq ss1 nil) (setq ss1 (ssadd)) (setq sstemp nil) (setq layer-name "Temp") (setq ssmain (ssget "_X" '((0 . "REGION")))) (setq ssmainlength (sslength ssmain)) (setq counter 1) (while (< counter ssmainlength) (if (= sstemp nil) (setq ent1name (ssname ssmain 0)) (setq ent1name (ssname sstemp 0)) );endif (setq obj1 (vlax-ename->vla-object ent1name)) (setq ent1area (vla-get-area obj1)) (ssadd ent1name ss1) (setq ent-data (entget ent1name)) (setq new-ent-data (subst (cons 8 layer-name) (assoc 8 ent-data) ent-data)) (entmod new-ent-data) (setq ent2name (ssname ssmain counter)) (setq obj2 (vlax-ename->vla-object ent2name)) (setq ent2area (vla-get-area obj2)) (ssadd ent2name ss1) (setq ent-data (entget ent2name)) (setq new-ent-data (subst (cons 8 layer-name) (assoc 8 ent-data) ent-data)) (entmod new-ent-data) (command "_.union" ss1 "") (setq ss2 (ssget "_X" '((0 . "REGION") (8 . "Temp")))) (setq ent3name (ssname ss2 0)) (setq obj3 (vlax-ename->vla-object ent3name)) (setq ent3area (vla-get-area obj3)) (setq difference (- (+ ent1area ent2area) ent3area)) (if (not (equal difference 0 0.0001)); tolerance (progn (command "_.UNDO" 1) (CopyToNewLayer) (Subtractfunction) (setq ss1 (ssget "_X" '((0 . "REGION") (8 . "Temp")))) (command "_.union" ss1 "") (alert (strcat "A difference of " (rtos difference 2 4) " has been found")) );end progn ):endif (setq sstemp (ssadd)) (setq sstemp (ssget "_X" '((0 . "REGION") (8 . "Temp")))) (setq counter (+ counter 1)) );end while );end defun

See if this code can help you, OP... (defun c:arcalc ( / ftoa ss es pt ent1name obj1 num1 ent2name obj2 num2 ent3name obj3 num3 ) (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com)) (defun ftoa ( n / m a s b ) (if (numberp n) (progn (setq m (fix ((if (< n 0) - +) n 1e-8))) (setq a (abs (- n m))) (setq m (itoa m)) (setq s "") (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0)))) (setq s (strcat s (itoa b))) (setq a (- (* a 10.0) b)) ) (if (= (type n) 'int) m (if (= s "") m (if (and (= m "0") (< n 0)) (strcat "-" m "." s) (strcat m "." s) ) ) ) ) ) ) (setq ss (ssadd)) (setq es (entsel "\nSelect region 1: ")) (setq ent1name (car es)) (setq pt (cadr es)) (setq obj1 (vlax-ename->vla-object ent1name)) (setq num1 (vla-get-area obj1)) (ssadd ent1name ss) (setq ent2name (car (entsel "\nSelect region 2: "))) (setq obj2 (vlax-ename->vla-object ent2name)) (setq num2 (vla-get-area obj2)) (ssadd ent2name ss) (if command-s (command-s "union" ss "") (vl-cmdf "union" ss "") ) (if (and ss (= (sslength ss) 1)) (setq ent3name (ssname ss 0)) (setq ent3name (car (nentselp pt))) ) (setq obj3 (vlax-ename->vla-object ent3name)) (setq num3 (vla-get-area obj3)) (setq *rtn* (- (+ num1 num2) num3)) (prompt "\nResulting area (sum and subtraction) is stored in global variable *rtn*... You can call it with : !*rtn*") (prompt "\n") (princ (ftoa *rtn*)) (princ) )

Thanks, learn something new every day.

its kinda a backwards way of thinking but when we modify an entity we are essentially "deleting" the old one and "creating" a new one.

Isn't it just the last thing created? You're making me think now!