Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 09/12/2022 in all areas

  1. Hi, the lisp, anticipated with two images here and here, aligns between two curves the hatch elements and creates a block containing the lines of the new geometry. The original shape of the hatch shall be a rectangle, an isosceles triangle or an isosceles trapezoid. In case of large hatches is recommended to divide it into portions, any case it is better to try with small hatches to verify the time required for processing, in according to PC performances, too. Not all hatches are suitable for processing. I hope it works well and there are no problems. AlignH.lsp
    1 point
  2. Generally speaking, its very possible so if you can give an example with a DWG then this would clarify the goal of the program and I will see if time serves then will not hesitate to help you for sure.
    1 point
  3. That's for someone else to explain I tend to keep my CAD as simple as possible so I can get a new or different computer and be working again as quick as possible and without spending hours creating new buttons and more detailed customisations, can't help you with that one If what I suggested above works go with that till someone else can answer for you, and then what is below will work. To select entities, use the ssget option and perhaps an internet search to give you https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-create-block-insert-that-block/td-p/5431779 Modify that might give you this: (defun c:chcol ( / MySS ) (setq MySS (ssget)) (command "chprop" MySS "" "C" "ByBlock" "") (c:blk MySS) ) ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-create-block-insert-that-block/td-p/5431779 ;;(defun c:blk (/ selectionset insertionpoint number Blockname) (defun c:blk (selectionset / insertionpoint number Blockname) ;; (if (and (setq selectionset (ssget "_:L")) (setq insertionpoint (getpoint "\n Specify Block Insertion Point :")) ;; ) (progn (setq number 1 Blockname (strcat "MyBlock" (itoa number)) ) (while (tblsearch "BLOCK" Blockname) (setq Blockname (strcat "MyBlock" (itoa (setq number (1+ number)))) ) ) (command "_.-Block" Blockname insertionpoint selectionset "") (command "_.-insert" Blockname insertionpoint "" "" "") ) (princ) ) (princ) )
    1 point
  4. Do you know that if you state or comment something subjective as word "bug", you are responsible for overcoming situation with knowledge and wisdom unique to your vision of composing harmonic and valuable system of functional algorithmic application (if your goal is in field of science based on computational technology)...
    1 point
  5. Try this UNTESTED program. NOTE: Be sure is that your Mtext objects are NOT formatted otherwise another approach with more functions is required to achieve that goal. (defun c:Test (/ str int sel ent get ins ) ;;----------------------------------------------------;; ;; Author : Tharwat Al Choufi ;; ;; website: https://autolispprograms.wordpress.com ;; ;;----------------------------------------------------;; (and (setq str (car (entsel "\nSelect text to search for similar content or as prefixed : "))) (or (wcmatch (cdr (assoc 0 (setq get (entget str)))) "TEXT,MTEXT") (alert "Invalid object selected. Try again") ) (or (setq ins (cdr (assoc 10 get)) int -1 sel (ssget "_X" (list '(0 . "TEXT,MTEXT") (cons 1 (strcat (cdr (assoc 01 get)) "*")) (cons 410 (getvar 'CTAB))))) (alert "Nno similar contents nor as prefixed string found <!>") ) (while (setq int (1+ int) ent (ssname sel int)) (or (equal str ent) (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) '(70 . 0) (cons 10 ins) (cons 10 (cdr (assoc 10 (entget ent)))))) ) ) ) (princ) )
    1 point
  6. and for buttons this should work as the command srtring (command "chprop" (car (entsel "Select")) "" "C" "ByBlock" "") I think
    1 point
  7. It is possible to change an entity colour temporarily for example if you're doing other stuff and want to highlight what you selected, then go back after, or to make a normal change
    1 point
  8. If t is a command from AutoCAD this is relatively to copy to a LISP, follow the above example as you need in future ( - tells the LISP you are about to do something command - tells the LISP that you are using a command "chprop" - tells the LISP the command name, here also in " " since you are entering text and not a variable (change this to whatever command you want to use) MyEnt - tells the LISP to enter a variable into the command (no " "), go to CAD command line and work through the command, copying what you type there into the LISP "" - puts in an enter / escape / space / end of selection, just as you would type into the command line "C" - tells the LISP the next value to pass to the command you are running, here "C" for colour "ByBlock" - as above, the next value to use "" - as above an enter / space / escape to end the selection, or here to end the comamnd ) - tells the LISP you have finished telling it to do something In between 'command' and the final ')' all you need to do is type into the LISP exactly what you type into the command line with " " either side of any text (but not if you are using a variable) .. hope this helps you out and can work it out next time
    1 point
  9. Thanks @Emmanuel Delay. That works great. I've just added some error handling. ; Given a layer name, return a list of the properties of that layer. ; https://www.cadtutor.net/forum/topic/60523-change-layer-keep-original-properties-lisp-routine/?do=findComment&comment=600356 (defun layer_get_properties (Lay /) laydata (entget (tblobjname "Layer" Lay)) ) (defun c:Lay_Zero_Keep_Colour (/ *error* acDoc ss i obj Lay ent layer_props col_obj col_lay wid_obj wid_lay typ_obj typ_lay) (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) ) (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc)) ;; user selects objects (setq ss (ssget)) (setq i 0) (repeat (sslength ss) ;; do for all select objects: (setq obj (ssname ss i)) (setq ent (entget obj)) ;; layer of the object (setq Lay (cdr (assoc 8 ent))) ;; layer properties (setq layer_props (layer_get_properties Lay)) ;; COLOR - property 62 ;; color of the object / color of the layer (setq col_obj (cdr (assoc 62 ent))) (setq col_lay (cdr (assoc 62 layer_props))) ;; Now we'll see if the object has set the color, or if the color is ByLayer. ;; If the color is ByLayer, then we should copy the color of the layer and set it to the object. (if (= nil col_obj) ;; object layer is set to ByLayer. (entmod (append ent (list (cons 62 col_lay)))) ) ;; Line width - property 370 (setq wid_obj (cdr (assoc 370 ent))) (setq wid_lay (cdr (assoc 370 layer_props))) (if (= nil wid_obj) (entmod (append ent (list (cons 370 wid_lay)))) ) ;; Line type - property 6 (setq typ_obj (cdr (assoc 6 ent))) (setq typ_lay (cdr (assoc 6 layer_props))) (if (= nil typ_obj) (entmod (append ent (list (cons 6 typ_lay)))) ) ;; set layer to "0" (entmod (subst (cons 8 "0") (assoc 8 ent) ent)) (setq i (+ i 1)) ) (*error* nil) (princ) )
    1 point
  10. There is nice functions by Gile that increments, say the BA BB BC etc. so could read an existing string and get a start number. Then say a pick pick pick sequence. ; Alpha2Number - Converts Alpha string into Number ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 1 ; Str$ = String to convert ; Syntax example: (Alpha2Number "ABC") = 731 ;------------------------------------------------------------------------------- (defun Alpha2Number (Str$ / Num#) (if (= 0 (setq Num# (strlen Str$))) 0 (+ (* (- (ascii (strcase (substr Str$ 1 1))) 64) (expt 26 (1- Num#))) (Alpha2Number (substr Str$ 2)) ) ) ) ;------------------------------------------------------------------------------- ; Number2Alpha - Converts Number into Alpha string ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 1 ; Num# = Number to convert ; Syntax example: (Number2Alpha 731) = "ABC" ;------------------------------------------------------------------------------- (defun Number2Alpha (Num# / Val#) (if (< Num# 27) (chr (+ 64 Num#)) (if (= 0 (setq Val# (rem Num# 26))) (strcat (Number2Alpha (1- (/ Num# 26))) "Z") (strcat (Number2Alpha (/ Num# 26)) (chr (+ 64 Val#))) ) ) );defun Number2Alpha
    1 point
  11. There are LISPs out there that will find the intersection of 2 lines or polylines, I think also 3d lines. Can you do entmod the first point of one line, the last point of the other to be this intersection point and then do a polyline join for 3d polyline - I think all these parts are out there sopmewhere
    1 point
  12. @faizur in addition to @ronjonp clean and simple solution, take a look here regards, aridzv.
    1 point
  13. 3d poly with same XY but different Z on matching end do not Meet. You have 2 choices flatten or push 1 end to the other end point.
    1 point
  14. Dimension overrides are messy and are lost when the drawing they're in are inserted into another drawing. A cleaner way might be to select a dimension you want modified, modify it in the Properties Palette, then right-click and select Dim Style → Save as New Dim Style… giving it a descriptive name like "Red→0.6 h0.5" Then just change any other dimensions to that Dim Style you want. Next time you need it just import that Dim Style or add it to any templates that Dim Style would be useful in.
    1 point
  15. Like mhupp a bit more detail not sure where I got this it is part code of a entmake a dim. Uses dxf number rather than VL name. So would use entmod method for your request (CONS 0 "DIMSTYLE") ;Entity Type (CONS 100 "AcDbSymbolTableRecord") ;Subclass marker (CONS 100 "AcDbDimStyleTableRecord") ;Subclass marker (CONS 2 xname$) ;Dimstyle name (CONS 70 0) ;Standard flag value (CONS 3 "") ;DIMPOST - Prefix and suffix for dimension text (CONS 4 "") ;DIMAPOST - Prefix and suffix for alternate text ;;(CONS 5 "ARR1") -DXF CODES OBSOLETE ;DIMBLK - Arrow block name ;;(CONS 6 "ARR1") -DXF CODES OBSOLETE ;DIMBLK1 - First arrow block name ;;(CONS 7 "") -DXF CODES OBSOLETE ;DIMBLK2 - Second arrow block name (CONS 40 100.0) ;DIMSCALE - Overall Scale Factor (CONS 41 1.0) ;DIMASZ - Arrow size (CONS 42 2.0) ;DIMEXO - Extension line origin offset (CONS 43 0.0) ;DIMDLI - Dimension line spacing (CONS 44 2.0) ;DIMEXE - Extension above dimension line (CONS 45 0.0) ;DIMRND - Rounding value (CONS 46 0.0) ;DIMDLE - Dimension line extension (CONS 47 0.0) ;DIMTP - Plus tolerance (CONS 48 0.0) ;DIMTM - Minus tolerance (CONS 140 xheight$) ;DIMTXT - Text height (CONS 141 0.09) ;DIMCEN - Centre mark size (CONS 142 0.0) ;DIMTSZ - Tick size (CONS 143 25.4) ;DIMALTF - Alternate unit scale factor (CONS 144 1.0) ;DIMLFAC - Linear unit scale factor (CONS 145 0.0) ;DIMTVP - Text vertical position (CONS 146 1.0) ;DIMTFAC - Tolerance text height scaling factor (CONS 147 1.0) ;DIMGAP - Gape from dimension line to text (CONS 71 0) ;DIMTOL - Tolerance dimensioning (CONS 72 0) ;DIMLIM - Generate dimension limits (CONS 73 0) ;DIMTIH - Text inside extensions is horizontal (CONS 74 0) ;DIMTOH - Text outside horizontal (CONS 75 0) ;DIMSE1 - Suppress the first extension line (CONS 76 0) ;DIMSE2 - Suppress the second extension line (CONS 77 1) ;DIMTAD - Place text above the dimension line (CONS 78 0) ;DIMZIN - Zero suppression (CONS 170 0) ;DIMALT - Alternate units selected (CONS 171 2) ;DIMALTD - Alternate unit decimal places (CONS 172 0) ;DIMTOFL - Force line inside extension lines (CONS 173 0) ;DIMSAH - Separate arrow blocks (CONS 174 0) ;DIMTIX - Place text inside extensions (CONS 175 0) ;DIMSOXD - Suppress outside dimension lines (CONS 176 1) ;DIMCLRD - Dimension line and leader color (CONS 177 1) ;DIMCLRE - Extension line color (CONS 178 xcolor$) ;DIMCRRT - Dimension text color (CONS 270 2) ;DIMUNIT (Obsolete in 2011, DIMLUNIT and DIMFRAC) (CONS 271 0) ;DIMADEC - Angular decimal places (CONS 272 0) ;DIMTDEC - Tolerance decimal places (CONS 273 2) ;DIMALTU - Alternate units (CONS 274 2) ;DIMALTTD - Alternate tolerance decimal places (CONS 275 0) ;DIMAUNIT - Angular unit format (CONS 280 0) ;DIMJUST - Justification of text on dimension line (CONS 281 0) ;DIMSD1 - Suppress the first dimension line (CONS 282 0) ;DIMSD2 - Suppress the second dimensions line (CONS 283 1) ;DIMTOLJ - Tolerance vertical justification (CONS 284 0) ;DIMTZIN - Zero suppression (CONS 285 0) ;DIMALTZ - Alternate unit zero suppression (CONS 286 0) ;DIMALTTZ - Alternate tolerance zero suppression (CONS 287 5) ;DIMFIT (Obsolete in 2011, DIMATFIT and DIMTMOVE) (CONS 288 1) ;DIMUPT - User positioned text (CONS 340 (TBLOBJNAME "STYLE" xstyle$)) ;DIMTXSTY - Text style (CONS 341 (CDR (ASSOC 330 (ENTGET (TBLOBJNAME "BLOCK" xstyle$)))) ) ;DIMLDRBLK - Leader arrow block name (CONS 342 (CDR (ASSOC 330 (ENTGET (TBLOBJNAME "BLOCK" xstyle$)))) ) ;DIMBLK - Arrow block name (CONS 343 (CDR (ASSOC 330 (ENTGET (TBLOBJNAME "BLOCK" xstyle$)))) ) ;DIMBLK1 - First arrow block name (CONS 344 (CDR (ASSOC 330 (ENTGET (TBLOBJNAME "BLOCK" xstyle$)))) ) ;DIMBLK2 - Second arrow block name ) ;End of list
    1 point
  16. Another way: (defun c:foo (/ ss) (if (setq ss (ssget '((0 . "*TEXT")))) (print (apply 'max (mapcar '(lambda (x) (atof (cdr (assoc 1 (entget x))))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ) ) ) ) (princ) )
    1 point
  17. convert strings to numbers with atof add it to a list use vl-sort > on list output first number in list ;;----------------------------------------------------------------------------;; ;;List Maximum Value (defun C:MValue (/ ss txt lst) (if (setq ss (ssget '((0 . "*TEXT")))) (foreach txt (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (setq value (atof (cdr (assoc 1 (entget txt))))) (setq lst (cons value lst)) (setq lst (vl-sort lst '>)) ) ) (prompt (strcat "\nMaximum Value: " (rtos (car lst) 2))) (princ) ) --Edit If your strings contain letters and numbers might have to do a little more before atof
    1 point
×
×
  • Create New...