Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 03/07/2024 in all areas

  1. and \U+00B2 for squared or \U+00B3 for cubed as an alternative to Alt+ ("\U+.... " works better in LISP) Can also use (chr 178) and (chr 179) ... which is why LISP is brilliant - so many ways to do the same thing! "\n Area = " (rtos a 2 2) " m\U+00B2" "\n Area = " (rtos a 2 2) " m " (chr 178)
    2 points
  2. As Mhupp suggested use BEDIT on the block, and click on attribute have properties open can change Tagname there, then do Bclose to save. You may need to attsync the block to update the redefinition of the block. Yes can do a get attribute1 change, then get next attribute, but to much effort compared to bedit.
    2 points
  3. I think you can do that in block editor. either that or explode the block rename the attribute and then remake the block
    2 points
  4. Like tombu i would suggest our dwt blocks 99% were set that objects were on layer 0, there is lisps that will do that for you. Then can delete layers.
    1 point
  5. Yes, but their is always going to be at least one dimstyle so why have the if statement if its always going to be true. --Edit Steven you could make it so you have declared variables to call to make the dimstyles (defun doesntworkentmakedimstyle (Name Scale /) ... (cons 2 name) ;Dim style name (cons 144 scale) ;Dim style scale ... called with (doesntworkentmakedimstyle (strcat "Linear-" (rtos scale 2 2)) scale) ;scale might have to be set as a double so 1.0 insted of 1
    1 point
  6. You could start from scratch. This rather curiously named LISP was in my library "doesntworkentmakedimstyle" I have commented out the parts that were stopping it from working. Maybe I should rename this "thisdoesworknowbutneedssomethinkingDimStyle" I think this is the complete list to entmake a dimstyle - not everything in this list is necessary, and it created a dimstyle "Dim_Name" just then for me. (defun c:doesntworkentmakedimstyle ( / ) (entmakex (list (cons 0 "DIMSTYLE") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbDimStyleTableRecord") (cons 2 "Dim_Name") ;Dim style name (cons 70 0) ; Standard flag (cons 3 " [m]") ; DIMPOST (cons 4 "") ; DIMAPOST ; (cons 5 DIMBLK-Name) ;DIMBLK-Name of block instead of default arrowhead ; (cons 6 DIMBLK-Name) ;(cons 6 "ClosedFilled"); DIMBLK1 (cons 7 "");(cons 7 DIMBLK-Name); DIMBLK2 (cons 170 0) ;DIMALT-turns off alternate units ; (cons 40 dimscale) ;DIMSCALE-sets the overall scale factor applied to all dimensions ; (cons 41 Arrow_Size) ;DIMASZ-sets the size of the arrow/tick ; (cons 42 Extension_Line_Origin_Offset); DIMEXO ; (cons 43 Dimension_Line_Spacing); DIMDLI ; (cons 44 Extension_Above_Dimension_Line) ;DIMEXE- how far to extend the extention line beyound the dim line (cons 45 0.0) ;DIMRND (cons 46 0) ;DIMDLE-sets the distance the dimension line extends beyond the extension line (cons 47 0.0) ;DIMTP (cons 48 0.0) ;DIMTM (cons 71 0) ;DIMTOL (cons 72 0) ;DIMLIM (cons 73 0) ;DIMTIH-controls the position of dimension text inside extention lines (cons 74 0) ;DIMTOH-controls the position of dimension text outside extention lines (cons 75 1) ;DIMSE1 ;1 sopprime la linea di estensione, 0 la lascia (cons 76 1) ;DIMSE2 ;1 sopprime la linea di estensione, 0 la lascia (cons 77 1) ;DIMTAD-controls the vertical position of text in relation to the dim line (cons 78 3) ;DIMZIN-controls the suppression of zeros (cons 79 1) ;DIMAZIN ; (cons 140 Text_Height);DIMTXT-specifies the height of the text in the dim ; (cons 141 Center_Mark_Size); DIMCEN (cons 142 0.0) ;DIMTSZ (cons 143 0.5) ;DIMALTF-controls the scale factor for alt. units ; (cons 144 quote_scale); DIMLFAC ;scala di quota (cons 145 0.0) ;DIMTVP (cons 146 0.64) ;DIMTFAC ; (cons 147 Gap_From_dimension_Line_to_Text) ;DIMGAP-sets the distance from around the dim text (cons 170 0) ;DIMALT (cons 171 2) ;DIMALTD-controls the decimal places for units (cons 172 0) ;DIMTOFL-forces a line inside extension lines (cons 173 1) ;DIMSAH (cons 174 0) ;DIMTIX (cons 175 0) ;DIMSOXD (cons 176 256) ;DIMCLRD (cons 177 256) ;DIMCLRE (cons 178 256) ;DIMCLRT color of text (cons 179 0) ;DIMADEC (cons 270 2) ;DIMUNIT-sets the units format for all dims ;2 decimale ; 4architettonico ; (cons 271 Decimal_Places) ;DIMDEC-sets the number of decimal places of primary units ; (cons 272 Tolerance_Decimal_places); DIMTDEC (cons 273 2) ;DIMALTU-sets the units for alt. units (cons 275 0) ;DIMAUNIT-sets the angular format for angular dims (cons 276 1); DIMFRAC (cons 277 2); DIMLUNIT ;2 decimale ; 4architettonico (cons 278 0); DIMDSEP ; (cons 279 Text_Movement); DIMTMOVE (cons 280 0) ;DIMJUST-controls the horizontal positioning of dim text (cons 281 -1); DIMSD1 (cons 282 -1); DIMSD2 (cons 283 1); DIMTOLJ (cons 284 3); DIMTZIN (cons 285 1); DIMALTZ (cons 286 0) ;DIMALTTZ-Toggles the suppression in tolerance values ; (cons 287 0); DIMFIT ; (cons 288 0); DIMUPT ; (cons 289 0); DIMATFIT ; (cons 340 (tblobjname "style" "Estilo_Cotas")); DIMTXSTY ; (cons 341 (cdr (assoc 330 (entget (tblobjname "block" "."))))); DIMLDRBLK ; (cons 342 (cdr (assoc 330 (entget(tblobjname "block" "_Oblique"))))); DIMBLK must setvar dimblk 1st ; (cons 343 (cdr (assoc 330 (entget(tblobjname "block" "_Oblique"))))); DIMBLK1 ; (cons 344 (cdr (assoc 330 (entget(tblobjname "block" "_Oblique"))))); DIMBLK2 ; (cons 371 -2); DIMLWD ; (cons 372 -2); DIMLWE )) ; end list, end entmakex (princ) ) and below is 'Jeff' which I use to quickly set a dim style - but for interest here are the descriptions which should match the above... though not in the same order of course, that would make life to easy. ;;Create Dimension Style (defun tablesearch ( s / d r) ;;List Dimstyles (while (setq d (tblnext s (null d))) (setq r (cons (cdr (assoc 2 d)) r)) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;https://stackoverflow.com/questions/47835301/use-autolisp-to-generate-new-dimension-style (defun c:SetDimStyle ( / )(jeff)) ;;Wrapper to change dimension style (defun c:jeff ( / DimStyleName DSN FontStyleName FSN FontHeight TxtCol LinCol Col TxtPrecision TxtPrec) ;;change dimension style ;;Dimension Style (princ "\nEnter Dimension style Name ")(princ (tableSearch "dimstyle")) (setq DimStyleName (getvar "dimstyle")) (setq DSN (getstring (strcat ": (" DimStyleName "): ") t)) (if (or (= DSN nil)(= DSN "")) (setq DimStyleName DimStyleName) (setq DimStyleName DSN) ) (princ DimStyleName) ;;Font Style (princ "\nEnter Font style Name ")(princ (tableSearch "style")) ;; (setq FontStyleName (nth 0 (tableSearch "style"))) (setq FontStyleName (getvar "textstyle")) (setq FSN (getstring (strcat " (" FontStyleName "): ") t)) (if (or (= FSN nil)(= FSN "")) (setq FontStyleName FontStyleName) (setq FontStyleName FSN) ) (princ FontStyleName) ;;Font Height (setq FontHeight 2.5) ;; How to get this from dimstyle selected above (setq FontHght (getreal (strcat "\nEnter Font Heght [" (rtos FontHeight)"]: "))) (if (or (= FontHght nil)(= FontHght "")) (setq FontHeight FontHeight) (setq FontHeight FontHght) ) (princ FontHeight) ;;Colours (setq TxtCol 0) ;Text. 0: By Layer, 256: ByBlock (setq Col (getint (strcat "\nEnter Text Colour Code (0: ByLayer, 256: ByBock) [" (rtos TxtCol)"]: "))) (if (or (= Col nil)(= Col "")) (setq TxtCol TxtCol) (setq TxtCol Col) ) (princ TxtCol) (setq LinCol 0) ;Lines. 0: By Layer, 256: ByBlock (setq Col (getint (strcat "\nEnter Lines Colour Code (0: ByLayer, 256: ByBock) [" (rtos LinCol)"]: "))) (if (or (= Col nil)(= Col "")) (setq LinCol LinCol) (setq LinCol Col) ) (princ LinCol) ;;Precision (setq TxtPrecision 4) ; number of decimal places ;; How to get this from dimstyle selected above (setq TxtPrec (getint (strcat "\nEnter Decimal Places) [" (rtos TxtPrecision) "]: "))) (if (or (= TxtPrec nil)(= TxtPrec "")) (setq TxtPrecision TxtPrecision) (setq TxtPrecision TxtPrec) ) (princ TxtPrecision)(princ " DP") (setq DimensionScale (/ FontHeight 2.5)) (jeff1 DimStyleName FontStyleName FontHeight TxtCol LinCol TxtPrecision DimensionScale) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun jeff1 ( DimStyleName FontName FontHeight TxtCol LinCol TxtPrecision DimensionScale / ) ;;Sub Routines (defun mytextstyle ( myfont / mytextstyle fontcount fontlist) ;;check textstyle is loaded ;;Font Style Lists ;;Fontname Height WidthFactor ObliqueAngle Backwards UpsideDown (setq fontstyles (list (list "Standard" "Arial" "0.0000" "1.0000" "0" "No" "No") (list "romans" "romans.shx" "0.0000" "1.0000" "0" "No" "No") (list "MMArial" "Arial" "0.0000" "1.0000" "0" "No" "No") (list "MM_Arial" "Arial" "0.0000" "1.0000" "0" "No" "No") ));end fontstyles list (if (member myfont (tableSearch "style")) (princ "Font Is Loaded") (progn ; Font isn't loaded (setq fontcount 0) (while (< fontcount (length fontstyles)) (if (= (strcase (nth 0 (nth fontcount fontstyles))) (strcase myfont)) (progn ;font style is loaded (setq fontlist fontcount) ;;font style exists ) ; end progn ) ;end if (setq fontcount (+ 1 fontcount)) ) (if (= fontlist nil) (progn ;;if font is not defined above or loaded (alert "Font style needs loading. Please edit it") (command "Style" myfont "romans.shx" "0.0000" "1.0000" "0" "No" "No" "No") (initdia) (command "style") ) ;end progn (progn (command "style" (nth 0 (nth fontlist fontstyles)) (nth 1 (nth fontlist fontstyles)) (nth 2 (nth fontlist fontstyles)) (nth 3 (nth fontlist fontstyles)) (nth 4 (nth fontlist fontstyles)) (nth 5 (nth fontlist fontstyles)) (nth 6 (nth fontlist fontstyles)) (nth 7 (nth fontlist fontstyles)) ) ;end command ) ;end progn ) ;end if ) ;end progn );end if (setq mystyle myfont) ;;text font style.. if anything else check if style is loaded into drawing here mystyle ) ;;End Sub Routines (mytextstyle FontName) ;; Check Font exists else make it ;;Full list of dimension variables. ;;Change all or none as required, save and existing style to update ;;NOTE: BYBLOCK and other texts to be numbers? ;;https://help.autodesk.com/view/ACDLTM/2016/ENU/?guid=GUID-30F44A49-4250-42D1-AEF2-5E2914ADB02B ;; List value ;; Default ;;Description (setvar "DIMADEC" TxtPrecision) ;; 0 ;;Angular Dimension Decimal Places ; (setvar "DIMALT" 0) ;; 0 ;;Control of alternative units 0 - Off 1 - On (setvar "DIMALTD" TxtPrecision) ;; 2 / 3 ;;Alternative Units Decimal Places ; (setvar "DIMALTF" 0.0394) ;; 25.4 / 0.0394 ;;Alternative Units Scale Factor ;;(setvar "DIMALTMZF") ;; ;;Alternate sub-zero factor for metric dimensions - Unknown variable ;;(setvar "DIMALTMZS") ;; ;;Alternate sub-zero suffix for metric dimensions - Unknown variable ; (setvar "DIMALTRND" 0.00) ;; 0.00 ;;Alternate units rounding value ; (setvar "DIMALTTD" 3) ;; 2 / 3 ;;Alternative Units Tolerance Decimal Places ; (setvar "DIMALTTZ" 0) ;; 0 ;;Alternate tolerance zero suppression ; (setvar "DIMALTU" 2) ;; 2 ;;Alternative Units Units ; (setvar "DIMALTZ" 0) ;; 0 ;;Alternate unit zero suppression ; (setvar "DIMAPOST" "") ;; "" ;;Prefix and suffix for alternate text ; (setvar "DIMARCSYM" 0) ;; 0 ;;Arc Length Dimension Arc Symbol (setvar "DIMASZ" FontHeight) ;; 0.18 / 2.5 ;;Dimension Line and Leader Line Arrow Heads size ; (setvar "DIMATFIT" 3) ;; 3 ;;Arrow and text fit if distance is too narrow for both ; (setvar "DIMAUNIT" 0) ;; 0 ;;Angular unit format ; (setvar "DIMAZIN" 0) ;; 0 ;;Angular Dimension Depresses leading zeros ; (setvar "DIMBLK" ".") ;; "." ;;Arrow block name "." for closed flled else as properties ; (setvar "DIMBLK1" ".") ;; "." ;;First arrow block name "." for closed flled else as properties ; (setvar "DIMBLK2" ".") ;; "." ;;Second arrow block name "." for closed flled else as properties (setvar "DIMCEN" FontHeight) ;; 0.09 / 2.5 ;;Drawing centre mark for radius or diameter dimensions (setvar "DIMCLRD" LinCol) ;; 0 ;;Colours - Lines, ArrowHeads, Dimension Lines 0: ByLayer, 256 ByBlock (setvar "DIMCLRE" LinCol) ;; 0 ;;Colours - Extension Lines, Centre Marks Colours 0: ByLayer, 256 ByBlock (setvar "DIMCLRT" TxtCol) ;; 0 ;;Colours - Dimension Text Colour 0: ByLayer, 256 ByBlock (setvar "DIMDEC" TxtPrecision) ;; 0 ;;Dimension Decimal Places ; (setvar "DIMDLE" 0) ;; 0.0000 ;;Dimension Line extension with oblique strokes instead of arrows ; (setvar "DIMDLI" 4) ;; 3.75 ;;Dimension Baseline Dimension Spacing (setvar "DIMDSEP" ".") ;; . ;;Decimal separator (setvar "DIMEXE" (/ Fontheight 2)) ;; 0.18 / 1.25 ;;Extension Line Extension distance (setvar "DIMEXO" (/ Fontheight 4)) ;; 0.0625 / 0.625 ;;Extension Line Offset ; (setvar "DIMFRAC" 0) ;; 0 ;;Dimension Fraction Format ; (setvar "DIMFXL" 1.00) ;; 1 ;;Fixed Extension Line ; (setvar "DIMFXLON" 0) ;; 0 ;;Enable Fixed Extension Line 0 - Off 1 - On (setvar "DIMGAP" (/ FontHeight 4)) ;; 0.09 / 0.625 ;;Dimension gap between text and arrow (setvar "DIMJOGANG" (* pi (/ 45 180.0))) ;; ;;Radius dimension jog angle.. radians? ; (setvar "DIMJUST" 0) ;; 0 ;;Justification of text on dimension line (setvar "DIMLDRBLK" ".") ;; "." ;;Leader block name "." for closed flled else as properties ; (setvar "DIMLFAC" 1.00) ;; 1 ;;Linear unit scale factor ; (setvar "DIMLIM" 0) ;; 0 ;;Generate dimension limits 0 - Off 1 - On (setvar "DIMLTEX1" "BYBLOCK") ;; "." ;;Linetype extension line 1 (setvar "DIMLTEX2" "BYBLOCK") ;; "." ;;Linetype extension line 2 (setvar "DIMLTYPE" "BYBLOCK") ;; "." ;;Dimension linetype ; (setvar "DIMLUNIT" 2) ;; 2 ;;Dimension Units (except angular) - number type ; (setvar "DIMLWD" -2) ;; -2 ;;Dimension Line Lineweights ; (setvar "DIMLWE" -2) ;; -2 ;;Extension Line Line Weight ;;(setvar "DIMMZF") ;; ;;Sub-zero factor for metric dimensions - Unknown variable ;;(setvar "DIMMZS") ;; ;;Sub-zero suffix for metric dimensions - Unknown variable ; (setvar "DIMPOST" "") ;; "" ;;Prefix and suffix for dimension text ; (setvar "DIMRND" 0) ;; 0 ;;Dimension Round distance to nearest n ; (setvar "DIMSAH" 0) ;; 0 ;;Separate arrow blocks 0 - Off 1 - On ; (setvar "DIMSCALE" 1) ;; 1 ;;Dimension Scale Factor ; (setvar "DIMSD1" 0) ;; 0 ;;Suppress the first dimension line 0 - Off 1 - On ; (setvar "DIMSD2" 0) ;; 0 ;;Suppress the second dimension line 0 - Off 1 - On ; (setvar "DIMSE1" 0) ;; 0 ;;Suppress the first extension line 0 - Off 1 - On ; (setvar "DIMSE2" 0) ;; 0 ;;Suppress the second extension line 0 - Off 1 - On ; (setvar "DIMSOXD" 0) ;; 0 ;;Suppress outside dimension lines ; (setvar "DIMTAD" 0) ;; 0 ;;Dimension Text Vertical distance ; (setvar "DIMTDEC" 4) ;; 4 ;;Tolerance decimal places ; (setvar "DIMTFAC" 1) ;; 1 ;;Dimension text scale factor of fractions relative to text height ; (setvar "DIMTFILL" 0) ;; 0 ;;Text background enabled ; (setvar "DIMTFILLCLR" 0) ;; 0 ;;Text background color 0: ByLayer, 256 ByBlock ; (setvar "DIMTIH" 0) ;; 0 ;;Text inside extensions is horizontal 0 - Off 1 - On ; (setvar "DIMTIX" 0) ;; 0 ;;Place text inside extensions 0 - Off 1 - On ; (setvar "DIMTM" 0) ;; 0 ;;Dimension Minus tolerance distance when used with dimtol, or dimlim ; (setvar "DIMTMOVE" 0) ;; 0 ;;Text movement ; (setvar "DIMTOFL" 0) ;; 0 ;;Force line inside extension lines 0 - Off 1 - On ; (setvar "DIMTOH" 1) ;; 1 ;;Text outside horizontal 0 - Off 1 - On ; (setvar "DIMTOL" 0) ;; 0 ;;Tolerance dimensioning 0 - Off 1 - On ; (setvar "DIMTOLJ" 1) ;; 0 ;;Tolerance vertical justification ; (setvar "DIMTP" 0) ;; 0 ;;Dimension Plus tolerance distance when used with dimtol, or dimlim ; (setvar "DIMTSZ" 0.00) ;; 0 ;;Tick size ; (setvar "DIMTVP" 0.00) ;; 0 ;;Text vertical position (setvar "DIMTXSTY" FontName) ;; Font ;;Text style (setvar "DIMTXT" FontHeight) ;; 0.18 / 2.5 ;;Dimension text Height ;;(setvar "DIMTXTDIRECTIONOff" 0) ;; ;;Dimension text direction 1 or 0 - NOT SURE IF THIS WORKS ; (setvar "DIMTZIN" 8) ;; 8 ;;Suppresses leading zeros in tolerance values ; (setvar "DIMUPT" 0) ;; 0 ;;User positioned text 0 - Off 1 - On ; (setvar "DIMZIN" 8) ;; 8 ;;Suppresses leading zeroes ;;Set Dimstyle named above to this list (setq dimstylelist (tableSearch "dimstyle")) (if (= (member DimStyleName dimstylelist) nil) (command "dimstyle" "s" DimStyleName) (command "dimstyle" "s" DimStyleName "Y") ) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1 point
  7. First, remove the parameters in the ssget function: (setq selection (ssget)) This gives you the standard prompt "Select objects:" and lets the user pick objects normally. Also remove the two statements before it, since you won't use p1 and p2. You can remove them from the list of local variables. Second, replace the statement (setq basePoint... ) with a statement that gets a base point from the user. Use the statement that gets newPoint if you need a template. Everything else should work the way the original code did. If you have a problem, let us know.
    1 point
  8. (vl-load-com) (defun c:test ( / blk lst1 i newTagList) (setq newTagList (list "NAME" "NUMBER" ;;"TAG3" ;; and feel free to add tags in case there's more than 2 ;;"TAG4" ;;"TAG5" )) (setq blk (vlax-ename->vla-object (car (entsel "\nSelect block: ")))) (setq lst1 (vlax-invoke blk 'getAttributes)) (setq i 0) (foreach att lst1 (vla-put-TagString att (nth i newTagList)) (setq i (+ i 1)) ) (princ) ) This code changes the attribute tags of selected blocks. But it probably doesn't solve the problem. It only changes the attribute of the INSERT, it doesn't update the definition of the block ... As everybody is saying: you probably better do block edit. Unless there's a reason why you prefer not to?
    1 point
  9. Something I was playing around with a while back. I use it form time to time. Made a little update yesterday and thought I'd add it here. Will allow you to select a group of objects and store them for later copying. This objects are stored in a global variable and do not have anything to do with the Clipboard. Once you store the objects, you can continue performing any normal functions and when you are ready to have those stored objects to place somewhere else, just execute the command. Call with Copystored or CS Sorry for the choppy video, I had to cut the frames to keep file size down (not sure what's going on with Camtasia). ;;; ------------------------------------------------------------------------ ;;; CopyStored.lsp v1.3 ;;; ;;; Copyright© 08.18.09 ;;; Alan J. Thompson (alanjt) ;;; ;;; Permission to use, copy, modify, and distribute this software ;;; for any purpose and without fee is hereby granted, provided ;;; that the above copyright notice appears in all copies and ;;; that both that copyright notice and the limited warranty and ;;; restricted rights notice below appear in all supporting ;;; documentation. ;;; ;;; The following program(s) are provided "as is" and with all faults. ;;; Alan J. Thompson DOES NOT warrant that the operation of the program(s) ;;; will be uninterrupted and/or error free. ;;; ;;; Allows user to select object(s) for copying (uses first object in ;;; selection for insertion point or specified point) and stores ;;; selection set and insertion point for later usage. ;;; ;;; Express Tools "acet-ss-drag-move" subroutine required. ;;; ;;; Revision History: ;;; ;;; v1.1 (09.29.09) 1. Changed copy method. ;;; 2. Updated error handler ;;; 3. Added AT:SS->List subroutine. ;;; ;;; v1.2 (12.15.09) 1. Updated to account for non WCS (oversite). ;;; ;;; v1.3 (02.23.10) 1. Added check if "acet-ss-drag-move" is loaded. ;;; 2. Added option to specify copy base point. ;;; ;;; ------------------------------------------------------------------------ CopyStored.lsp
    1 point
  10. Sorry. Doesn't look like I made any updates since. Code is definitely ugly, but unless I was going to add some additional functionality or fix a reported bug, it's not worth rewriting.
    1 point
  11. @Mr Bojangles No problem, if I put the code in plain text, it's because I'm sharing it otherwise I would compile the code if I wanted to keep control of it.
    1 point
  12. A start with this? (defun def_bulg_pl (ls lb / l_rad) (setq ls (append ls (list (car ls)))) (while (cadr ls) (if (zerop (car lb)) (setq l_rad (cons (car lb) l_rad)) (setq l_rad (cons (/ (distance (car ls) (cadr ls)) (sin (* 2.0 (atan (abs (car lb))))) 2.0) l_rad)) ) (setq ls (cdr ls) lb (cdr lb)) ) l_rad ) (defun c:test ( / sspl typent lst l_bulg e_next dxf_next rad) (while (null (setq sspl (ssget "_+.:E:S" '((0 . "*POLYLINE") (-4 . "<AND") (-4 . "&") (70 . 1) (-4 . "<NOT") (-4 . "&") (70 . 124) (-4 . "NOT>") (-4 . "AND>"))))) (princ "\nInvalid object") ) (setq typent (cdr (assoc 0 (setq dxf_ent (entget (setq ent (ssname sspl 0))))))) (cond ((eq typent "LWPOLYLINE") (setq lst (mapcar '(lambda (x) (trans x ent 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent))) l_bulg (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 42)) dxf_ent)) lst (def_bulg_pl lst l_bulg) ) ) ((eq typent "POLYLINE") (setq e_next (entnext ent)) (while (= "VERTEX" (cdr (assoc 0 (setq dxf_next (entget e_next))))) (if (zerop (boole 1 223 (cdr (assoc 70 dxf_next)))) (setq lst (cons (trans (cdr (assoc 10 dxf_next)) ent 1) lst) l_bulg (cons (cdr (assoc 42 dxf_next)) l_bulg) ) ) (setq e_next (entnext e_next)) ) (setq lst (reverse lst) l_bulg (reverse l_bulg) lst (def_bulg_pl lst l_bulg) ) ) ) (if (setq rad (car (vl-remove 0.0 (vl-sort lst '<)))) (princ (strcat "\nMinor radius found " (rtos rad 2))) (princ "\nNo radius found in this polyline") ) (prin1) )
    1 point
  13. (defun c:cost () (setq a (getreal "\nEnter Area in m2: ")) ; Get area input (setq k (/ (+ (* a 2.5) 75) 1.24)) ; Calculate cost (princ (strcat "\nCalculate cost" "\n--------------------------------" "\n Area = " (rtos a 2 2) " m2" "\n Cost = " (rtos k 2 2) "\n--------------------------------")) (princ) ) I fix it. Thanks
    1 point
×
×
  • Create New...