Jump to content

Leaderboard

Popular Content

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

  1. Macros can use lisp commands ^c^c(command "chprop" (ssget '((0 . "INSERT"))) "" "C" "ByBlock" "")
    3 points
  2. copy and paste.... I reckon it should be a double \\, if it is within " ",
    2 points
  3. In Lee's example he uses "\\" not "\" though. No way of testing either of ours as we don't have that path on our PC's.
    2 points
  4. Still think you should give it a simple descriptive name like "Red→0.6 h0.5" so it will make more sense to other users who open the drawing. Later you may have a few Dimension Styles to chose from and it will help you pick the right one.
    1 point
  5. Here is something I cobbled, but if you really need it working, you'll have to debug it further... Regards... (defun c:treelengths ( / *error* picknode process processtree maketree cmd ucsf bp ss i e el elst slst lst s tree len q enx ) (vl-load-com) (defun *error* ( m ) (if ucsf (if command-s (command-s "_.UCS" "_P") (vl-cmdf "_.UCS" "_P") ) ) (if command-s (command-s "_.UNDO" "_E") (vl-cmdf "_.UNDO" "_E") ) (if cmd (setvar (quote cmdecho) cmd) ) (if m (prompt m) ) (princ) ) (defun picknode ( e / s ) (if (and e (setq s (ssget "_C" (mapcar (function +) (list -1e-3 -1e-3) (trans (cadadr e) 0 1)) (mapcar (function +) (list 1e-3 1e-3) (trans (cadadr e) 0 1)))) (ssdel (car e) s) (> (sslength s) 0) ) s ) ) (defun process ( s e / ee ) (setq ee (vl-remove-if-not (function (lambda ( x ) (ssmemb (car x) s))) lst)) (setq ee (mapcar (function (lambda ( x ) (list (car x) (if (equal (caadr x) (cadadr e) 1e-6) (list (caadr x) (cadadr x)) (list (cadadr x) (caadr x)))))) ee)) (if (and ee (setq s (picknode (car ee))) ) (progn (setq tree (cons (car ee) tree)) (process s (car ee)) ) (if ee (setq tree (cons (car ee) tree)) ) ) ) (defun processtree nil (setq re (cons (caar tree) re)) (setq tree (cdr tree)) (if (and (setq s (picknode (car tree))) (foreach w re (ssdel w s) ) (> (sslength s) 0) ) (process s (car tree)) (processtree) ) ) (defun maketree ( q ) (setq len (apply (function +) (mapcar (function (lambda ( x ) (vlax-curve-getdistatparam (car x) (vlax-curve-getendparam (car x))))) tree))) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 10 (polar (cadadr (car tree)) (* -0.5 pi) (if (/= (getvar (quote textsize)) 0.0) (getvar (quote textsize)) (* 10.0 (/ (getvar (quote viewsize)) (cadr (getvar (quote screensize)))))))) (cons 1 (rtos len 2 8)) (cons 40 (if (/= (getvar (quote textsize)) 0.0) (getvar (quote textsize)) (* 10.0 (/ (getvar (quote viewsize)) (cadr (getvar (quote screensize))))))) (cons 50 0.0) (cons 62 q) (list 210 0.0 0.0 1.0) ) ) (setq el (entlast)) (foreach e (mapcar (function car) tree) (vla-copy (vlax-ename->vla-object e)) ) (setq s (ssadd)) (while (setq el (entnext el)) (ssadd el s) ) (setq el (entlast)) (vl-cmdf "_.JOIN" s "") (if (not (eq el (entlast))) (if (assoc 62 (setq enx (entget (entlast)))) (entupd (cdr (assoc -1 (entmod (subst (cons 62 q) (assoc 62 enx) enx))))) (entupd (cdr (assoc -1 (entmod (append enx (list (cons 62 q))))))) ) (if (assoc 62 (setq enx (entget (ssname s 0)))) (entupd (cdr (assoc -1 (entmod (subst (cons 62 q) (assoc 62 enx) enx))))) (entupd (cdr (assoc -1 (entmod (append enx (list (cons 62 q))))))) ) ) ) (setq cmd (getvar (quote cmdecho))) (setvar (quote cmdecho) 0) (if (= 8 (logand 8 (getvar (quote undoctl)))) (vl-cmdf "_.UNDO" "_E") ) (vl-cmdf "_.UNDO" "_G") (if (= 0 (getvar (quote worlducs))) (progn (vl-cmdf "_.UCS" "_W") (setq ucsf t) ) ) (if (setq bp (getpoint "\nPick or specify base point : ")) (progn (setq ss (ssget "_X" (list (cons 0 "*POLYLINE,LINE,ARC,SPLINE,ELLIPSE,HELIX") (cons 410 (if (= (getvar (quote cvport)) 1) (getvar (quote ctab)) "Model"))))) (repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i)))) (setq el (entlast)) (if e (cond ( (wcmatch (cdr (assoc 0 (entget e))) "*POLYLINE") (vl-cmdf "_.EXPLODE" e) (while (setq el (entnext el)) (vl-cmdf "_.PEDIT" el "") (setq elst (cons (if (and el (not (vlax-erased-p el)) (= (cdr (assoc 0 (entget el))) "LWPOLYLINE")) el (entlast)) elst)) ) ) ( (wcmatch (cdr (assoc 0 (entget e))) "LINE,ARC") (vl-cmdf "_.PEDIT" e "") (setq elst (cons (if (and e (not (vlax-erased-p e)) (= (cdr (assoc 0 (entget e))) "LWPOLYLINE")) e (entlast)) elst)) ) ( (wcmatch (cdr (assoc 0 (entget e))) "SPLINE,ELLIPSE,HELIX") (setq slst (cons e slst)) ) ) ) ) (setq lst (append elst slst)) (setq lst (mapcar (function (lambda ( x ) (list x (list (vlax-curve-getstartpoint x) (vlax-curve-getendpoint x))))) lst)) (setq e (car (vl-remove-if (function (lambda ( x ) (not (or (equal (trans bp 1 0) (caadr x) 1e-6) (equal (trans bp 1 0) (cadadr x) 1e-6))))) lst))) (setq e (list (car e) (if (equal (trans bp 1 0) (caadr e) 1e-6) (list (caadr e) (cadadr e)) (list (cadadr e) (caadr e))))) (setq tree (cons e tree)) (if (setq s (picknode e)) (process s e) ) (while (not (equal otree tree 1e-6)) (setq q (if (not q) 1 (1+ q))) (setq otree tree) (processtree) (maketree q) ) ) ) (*error* nil) )
    1 point
  6. D'Oh!! and D'Oh again.. beaten to it again..... A bit of a brute force method below though without stealing form another drawing, hoping I copied and pasted all the parts you need. Problem I have had in the past is that our IT mess up file paths with each server upgrade or so it seams, I'd prefer to avoid reference drawings for steal. Run with the command jefflist as a nod to the reference I posted above. An interesting one for just after dinner here. Just seen I refer to 'reverse Jeff' in the notes, that's another thing entirely, don't worry about that. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:jefflist ( / DimStyleName DSN FontStyleName FSN DimensionScale dimvariableslist) ;;;;;;;;;;A List using reversejeff of all the dimension variables. Copy and paste from clipboard to here ;;;;;;;;;;;;;; (setq DimName "00000204F71894182") (setq dimvariableslist (list 0 0 2 25.4 0.0 2 0 2 0 "" 0 0.85 3 0 0 "" "" "" 0.09 1 1 1 4 0.0 0.38 "." 0.18 0.0625 2 1.0 0 0.09 0.785398 0 "" 1.0 0 "ByBlock" "ByBlock" "ByBlock" 5 -2 -2 "\"" 0.0 0 1.0 0 0 0 0 0 0 4 1.0 0 0 1 0 0.0 0 0 1 0 1 0.0 0.0 0.0 "Standard" 0.63 0 0 0)) ;; See below for description of each item in this list ;;;;;;;;;;End of dimension description ;;;;;;;;;;;;;; ;;Sub Routines (defun tablesearch ( s / d r) ;;List Dimstyles (while (setq d (tblnext s (null d))) (setq r (cons (cdr (assoc 2 d)) r)) ) ) (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 "CoArial" "Arial" "0.0000" "1.0000" "0" "No" "No") (list "Company_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 ;;Dimension Style (princ "Exsting DIM styles: ")(princ (tableSearch "dimstyle")) (setq DimStyleName (nth 0 (tableSearch "dimstyle"))) (setq DSN DimName) (if (or (= dsn nil)(= DSN "")) (setq DimStyleName DimStyleName) (setq DimStyleName DSN) ) ;;Font Style (princ "Loaded Text Fonts: ")(princ (tableSearch "style")) (setq FontStyleName (nth 0 (tableSearch "style"))) (setq FSN (nth 68 dimvariableslist) ) (if (or (= dsn nil)(= DSN "")) (setq FontStyleName FontStyleName) (setq FontStyleName FSN) ) (mytextstyle FontStyleName) ;;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 (setvar "DIMADEC" (nth 0 dimvariableslist));;Angular Dimension Decimal Places (setvar "DIMALT" (nth 1 dimvariableslist));;Control of alternative units 0 - Off 1 - On (setvar "DIMALTD" (nth 2 dimvariableslist));;Alternative Units Decimal Places (setvar "DIMALTF" (nth 3 dimvariableslist));;Alternative Units Scale Factor (setvar "DIMALTRND" (nth 4 dimvariableslist));;Alternate units rounding value (setvar "DIMALTTD" (nth 5 dimvariableslist));;Alternative Units Tolerance Decimal Places (setvar "DIMALTTZ" (nth 6 dimvariableslist));;Alternate tolerance zero suppression (setvar "DIMALTU" (nth 7 dimvariableslist));;Alternative Units Units (setvar "DIMALTZ" (nth 8 dimvariableslist));;Alternate unit zero suppression (setvar "DIMAPOST" (nth 9 dimvariableslist));;Prefix and suffix for alternate text (setvar "DIMARCSYM" (nth 10 dimvariableslist));;Arc Length Dimension Arc Symbol (setvar "DIMASZ" (nth 11 dimvariableslist));;Dimension Line and Leader Line Arrow Heads size (setvar "DIMATFIT" (nth 12 dimvariableslist));;Arrow and text fit if distance is too narrow for both (setvar "DIMAUNIT" (nth 13 dimvariableslist));;Angular unit format (setvar "DIMAZIN" (nth 14 dimvariableslist));;Angular Dimension Depresses leading zeros (setvar "DIMBLK" (nth 15 dimvariableslist));;Arrow block name "." for closed flled else as properties (setvar "DIMBLK1" (nth 16 dimvariableslist));;First arrow block name "." for closed flled else as properties (setvar "DIMBLK2" (nth 17 dimvariableslist));;Second arrow block name "." for closed flled else as properties (setvar "DIMCEN" (nth 18 dimvariableslist));;Drawing centre mark for radius or diameter dimensions (setvar "DIMCLRD" (nth 19 dimvariableslist));;Colours - Lines, ArrowHeads, Dimension Lines 0: ByLayer, 256 ByBlock (setvar "DIMCLRE" (nth 20 dimvariableslist));;Colours - Extension Lines, Centre Marks Colours 0: ByLayer, 256 ByBlock (setvar "DIMCLRT" (nth 21 dimvariableslist));;Colours - Dimension Text Colour 0: ByLayer, 256 ByBlock (setvar "DIMDEC" (nth 22 dimvariableslist));;Dimension Decimal Places (setvar "DIMDLE" (nth 23 dimvariableslist));;Dimension Line extension with oblique strokes instead of arrows (setvar "DIMDLI" (nth 24 dimvariableslist));;Dimension Baseline Dimension Spacing (setvar "DIMDSEP" (nth 25 dimvariableslist));;Decimal separator (setvar "DIMEXE" (nth 26 dimvariableslist));;Extension Line Extension distance (setvar "DIMEXO" (nth 27 dimvariableslist));;Extension Line Offset (setvar "DIMFRAC" (nth 28 dimvariableslist));;Dimension Fraction Format (setvar "DIMFXL" (nth 29 dimvariableslist));;Fixed Extension Line (setvar "DIMFXLON" (nth 30 dimvariableslist));;Enable Fixed Extension Line 0 - Off 1 - On (setvar "DIMGAP" (nth 31 dimvariableslist));;Dimension gap between text and arrow (setvar "DIMJOGANG" (nth 32 dimvariableslist));;Radius dimension jog angle.. radians? (setvar "DIMJUST" (nth 33 dimvariableslist));;Justification of text on dimension line (setvar "DIMLDRBLK" (nth 34 dimvariableslist));;Leader block name "." for closed flled else as properties (setvar "DIMLFAC" (nth 35 dimvariableslist));;Linear unit scale factor (setvar "DIMLIM" (nth 36 dimvariableslist));;Generate dimension limits 0 - Off 1 - On (setvar "DIMLTEX1" (nth 37 dimvariableslist));;Linetype extension line 1 (setvar "DIMLTEX2" (nth 38 dimvariableslist));;Linetype extension line 2 (setvar "DIMLTYPE" (nth 39 dimvariableslist));;Dimension linetype (setvar "DIMLUNIT" (nth 40 dimvariableslist));;Dimension Units (except angular) - number type (setvar "DIMLWD" (nth 41 dimvariableslist));;Dimension Line Lineweights (setvar "DIMLWE" (nth 42 dimvariableslist));;Extension Line Line Weight (setvar "DIMPOST" (nth 43 dimvariableslist));;Prefix and suffix for dimension text (setvar "DIMRND" (nth 44 dimvariableslist));;Dimension Round distance to nearest n (setvar "DIMSAH" (nth 45 dimvariableslist));;Separate arrow blocks 0 - Off 1 - On (setvar "DIMSCALE" (nth 46 dimvariableslist));;Dimension Scale Factor (setvar "DIMSD1" (nth 47 dimvariableslist));;Suppress the first dimension line 0 - Off 1 - On (setvar "DIMSD2" (nth 48 dimvariableslist));;Suppress the second dimension line 0 - Off 1 - On (setvar "DIMSE1" (nth 49 dimvariableslist));;Suppress the first extension line 0 - Off 1 - On (setvar "DIMSE2" (nth 50 dimvariableslist));;Suppress the second extension line 0 - Off 1 - On (setvar "DIMSOXD" (nth 51 dimvariableslist));;Suppress outside dimension lines (setvar "DIMTAD" (nth 52 dimvariableslist));;Dimension Text Vertical distance (setvar "DIMTDEC" (nth 53 dimvariableslist));;Tolerance decimal places (setvar "DIMTFAC" (nth 54 dimvariableslist));;Dimension text scale factor of fractions relative to text height (setvar "DIMTFILL" (nth 55 dimvariableslist));;Text background enabled (setvar "DIMTFILLCLR" (nth 56 dimvariableslist));;Text background color 0: ByLayer, 256 ByBlock (setvar "DIMTIH" (nth 57 dimvariableslist));;Text inside extensions is horizontal 0 - Off 1 - On (setvar "DIMTIX" (nth 58 dimvariableslist));;Place text inside extensions 0 - Off 1 - On (setvar "DIMTM" (nth 59 dimvariableslist));;Dimension Minus tolerance distance when used with dimtol, or dimlim (setvar "DIMTMOVE" (nth 60 dimvariableslist));;Text movement (setvar "DIMTOFL" (nth 61 dimvariableslist));;Force line inside extension lines 0 - Off 1 - On (setvar "DIMTOH" (nth 62 dimvariableslist));;Text outside horizontal 0 - Off 1 - On (setvar "DIMTOL" (nth 63 dimvariableslist));;Tolerance dimensioning 0 - Off 1 - On (setvar "DIMTOLJ" (nth 64 dimvariableslist));;Tolerance vertical justification (setvar "DIMTP" (nth 65 dimvariableslist));;Dimension Plus tolerance distance when used with dimtol, or dimlim (setvar "DIMTSZ" (nth 66 dimvariableslist));;Tick size (setvar "DIMTVP" (nth 67 dimvariableslist));;Text vertical position (setvar "DIMTXSTY" (nth 68 dimvariableslist));;Text style (setvar "DIMTXT" (nth 69 dimvariableslist));;Dimension text Height (setvar "DIMTZIN" (nth 70 dimvariableslist));;Suppresses leading zeros in tolerance values (setvar "DIMUPT" (nth 71 dimvariableslist));;User positioned text 0 - Off 1 - On (setvar "DIMZIN" (nth 72 dimvariableslist));;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 make sure you've saved Lee's lisp in a Trusted Support folder! This macro should work as \ pauses for user input I've used (chr 92) which when entered at the command line returns "\\" the seperater ^C^C^P(or C:Steal (load "StealV1-8.lsp"))(Steal (strcat "D:" (chr 92) "Andi" (chr 92) "Program" (chr 92) "Dimstyle.dwg") '(("Dimension Styles"("00000204F7189418")))) .regen or at the command or added as a line to acaddoc.lsp file to load it into any drawing you open (or C:Steal (load "StealV1-8.lsp"))(Steal (strcat "D:" (chr 92) "Andi" (chr 92) "Program" (chr 92) "Dimstyle.dwg") '(("Dimension Styles"("00000204F7189418"))))
    1 point
  8. (defun C:DStyle () (Steal "D:\\Andi\\Program\\Dimstyle.dwg" '(( "Dimension Styles" ("00000204F7189418")))) (princ) )
    1 point
  9. 1 point
  10. Yup you are right, here is the revised one to increment down on Y direction. (defun c:Test (/ int sel ent get lst fun str tmp ltr pre key opr) ;;----------------------------------------------------;; ;; Author : Tharwat Al Choufi ;; ;; website: https://autolispprograms.wordpress.com ;; ;;----------------------------------------------------;; (and (or (initget "X Y") (setq key (getkword "\nSpecify direction of attributed blocks to increment alphabatically [ X / Y ] : ")) ) (setq pre (getstring "\nSpecify prefix with letter at the end : ")) (or (or (<= 65 (ascii (setq ltr (strcase (substr pre (strlen pre))))) 90) (= "" pre) ) (alert "Prefix must end with letter <!>") ) (princ "\nSelect Attributed blocks < tert > : ") (setq str pre int -1 sel (ssget "_:L" '((0 . "INSERT") (2 . "tert") (66 . 1)))) (while (setq int (1+ int) ent (ssname sel int)) (setq get (entget ent) lst (cons (list (cdr (assoc 10 get)) ent) lst) ) ) (if (= key "X") (setq fun car opr <) (setq fun cadr opr >) ) (mapcar (function (lambda (obj) (setq pre str obj (cadr obj)) (while (/= (cdr (assoc 0 (setq get (entget (setq obj (entnext obj)))))) "SEQEND") (entmod (subst (cons 1 (setq pre (strcat pre ltr))) (assoc 1 get) get)) ) (if (<= 65 (setq tmp (1+ (ascii ltr))) 90) (setq ltr (chr tmp)) (setq str (strcat str "Z") ltr "A") ) ) ) (vl-sort lst (function (lambda (j k) (opr (fun (car j)) (fun (car k))))))) ) (princ) ) (vl-load-com)
    1 point
  11. I was modifying the codes to work with the center point of Mtexts along with exporting info to text file. Try it now and let me know. (defun c:Test (/ *error* str int sel ent get ins xpo ypo pos lst txt opn dim rtn rot wid ) ;;----------------------------------------------------;; ;; Author : Tharwat Al Choufi ;; ;; website: https://autolispprograms.wordpress.com ;; ;;----------------------------------------------------;; (defun *error* (msg) (and dim (setvar 'DIMZIN dim)) (and opn (close opn)) (and msg (not (wcmatch (strcase msg) "*CANCEL*,*EXIT*,*BREAK*")) (princ (strcat "\nError =>: " msg)) ) (princ "\nThis AutoLISP program was written by Tharwat Al Choufi" ) (princ) ) (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 (assoc 10 get) xpo (car (cdr ins)) ypo (cadr (cdr ins)) 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 <!>" ) ) (setq dim (getvar 'DIMZIN)) (setvar 'DIMZIN 0) (setq rot (cdr (assoc 50 get)) ins (polar (polar (cdr ins) rot (/ (cdr (assoc 42 get)) 2.0)) (- rot (* pi 0.5)) (/ (cdr (assoc 40 get)) 2.0) ) ) (while (setq int (1+ int) ent (ssname sel int) ) (or (equal str ent) (and (setq get (entget ent) pos (assoc 10 get) wid (cdr (assoc 42 get)) rot (cdr (assoc 50 get)) ) (setq cnt (polar (polar (cdr pos) rot (/ wid 2.0)) (- rot (* pi 0.5)) (/ (cdr (assoc 40 get)) 2.0) ) ) (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) '(70 . 0) (cons 10 ins) (cons 10 (setq pos (polar (polar (cdr pos) rot (/ wid 2.0)) (- rot (* pi 0.5)) (/ (cdr (assoc 40 get)) 2.0) ) ) ) ) ) (setq lst (cons (list (cdr (assoc 1 get)) (rtos (abs (- xpo (car pos))) 2 4) (rtos (abs (- ypo (cadr pos))) 2 4) ) lst ) ) ) ) ) (setq txt (getfiled "Save as." (getvar 'DWGPREFIX) "txt" 1)) (setq opn (open txt "w")) (write-line "MTEXT\tX\tY" opn) (setq lst (vl-sort lst (function (lambda (j k) (< (car j) (car k))))) ) (while (setq rtn (car lst)) (write-line (strcat (car rtn) "\t" (cadr rtn) "\t" (caddr rtn)) opn ) (setq lst (cdr lst)) ) ) (*error* nil) (princ) ) (vl-load-com)
    1 point
  12. I'hve manage to finishe lisp with good results. Thank you Tharwat for your help with starting lisp. Have a nice day.
    1 point
  13. Thanks a lot i aveva lot of difficult to learn...and is possible then assign color 200 ti the block ?then is perfect
    1 point
  14. Like Steven a more global solution using the Gile code you can start with any combination you like 1-B, 1-BB, 1-BBB and so on would pick say the "1-B" pull the "B" suffix and get a number using Alpha2Number then add 1 use strcat "1-" and Number2Alpha so next is 1-C, next 1-D up to 1-Z, then it becomes 1-AA, 1-AB. Picking start text makes it easier to set just that. Need asdfgh want an auto answer or a pick, pick, pick answer. 2nd question is it always a block attribute or mtext or text, may need to do for all 3.
    1 point
  15. If you don't care what the name is this would make them unique: (defun c:ub (/ b s) (if (and (setq b (car (entsel "\nSelect Block"))) (= "INSERT" (cdr (assoc 0 (entget b)))) (setq s (ssget "_X" (list '(0 . "INSERT") (assoc 2 (entget b))))) ) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (vla-converttoanonymousblock (vlax-ename->vla-object e)) ) ) (princ) ) (vl-load-com)
    1 point
  16. I think your magenta polylines are not that accurate since they are not connected in the center of Mtext objects nor they are connected from the insertion point of each Mtext, so is it okay to get the X and Y from the insertion point of Mtexts ? otherwise you need to specify how did you get that base point that you connected from the original text C2 to the other texts.
    1 point
  17. Give this a try and let me know if it is the one you are after. (defun c:Test (/ int sel ent get lst fun str tmp ltr pre key ) ;;----------------------------------------------------;; ;; Author : Tharwat Al Choufi ;; ;; website: https://autolispprograms.wordpress.com ;; ;;----------------------------------------------------;; (and (or (initget "X Y") (setq key (getkword "\nSpecify direction of attributed blocks to increment alphabatically [ X / Y ] : ")) ) (setq pre (getstring "\nSpecify prefix with letter at the end : ")) (or (or (<= 65 (ascii (setq ltr (strcase (substr pre (strlen pre))))) 90) (= "" pre) ) (alert "Prefix must end with letter <!>") ) (princ "\nSelect Attributed blocks < tert > : ") (setq str pre int -1 sel (ssget "_:L" '((0 . "INSERT") (2 . "tert") (66 . 1)))) (while (setq int (1+ int) ent (ssname sel int)) (setq get (entget ent) lst (cons (list (cdr (assoc 10 get)) ent) lst) ) ) (setq fun (if (= key "X") car cadr)) (mapcar (function (lambda (obj) (setq pre str obj (cadr obj)) (while (/= (cdr (assoc 0 (setq get (entget (setq obj (entnext obj)))))) "SEQEND") (entmod (subst (cons 1 (setq pre (strcat pre ltr))) (assoc 1 get) get)) ) (if (<= 65 (setq tmp (1+ (ascii ltr))) 90) (setq ltr (chr tmp)) (setq str (strcat str "Z") ltr "A") ) ) ) (vl-sort lst (function (lambda (j k) (< (fun (car j)) (fun (car k))))))) ) (princ) ) (vl-load-com)
    1 point
  18. 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
  19. 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
  20. Yes, that is how most variables work and you either have to remember what the numbers mean, look them up, or use the dump to see what current settings are. I used vdump on a dimension and this are all the current properties you can change (unless they are locked has RO - read only). As you can see most use numbers. So lets say you wanted to show the alternate units in the dims. Currently its set to 0 or off (vla-put-AltUnits obj 1) ;turns alt units on (vla-put-TextSuffix obj "mm") ;adds mm to the end of alt units ; IAcadDimRotated 2798f900 : TeighaX Interface of a dimension that measures the distance between two points and is displayed at a given rotation ; ; Property values : ; ; AltRoundDistance = 0.0 ; AltSubUnitsFactor = NIL ; AltSubUnitsSuffix = NIL ; AltSuppressLeadingZeros = 0 ; AltSuppressTrailingZeros = 0 ; AltSuppressZeroFeet = -1 ; AltSuppressZeroInches = -1 ; AltTextPrefix = "" ; AltTextSuffix = "" ; AltTolerancePrecision = 2 ; AltToleranceSuppressLeadingZeros = 0 ; AltToleranceSuppressTrailingZeros = 0 ; AltToleranceSuppressZeroFeet = -1 ; AltToleranceSuppressZeroInches = -1 ; AltUnits = 0 ; AltUnitsFormat = 2 ; AltUnitsPrecision = 2 ; AltUnitsScale = 25.4 ; Application (RO) = #<VLA-OBJECT IAcadApplication 0000000027634DF0> ; Arrowhead1Block = "" ; Arrowhead1Type = 0 ; Arrowhead2Block = "" ; Arrowhead2Type = 0 ; ArrowheadSize = 0.35 ; color = 256 ; Database (RO) = #<VLA-OBJECT IAcadDatabase 0000000027DF9408> ; DecimalSeparator = "." ; DimConstrDesc = NIL ; DimConstrExpression = NIL ; DimConstrForm = NIL ; DimConstrName = NIL ; DimConstrReference = NIL ; DimConstrValue = NIL ; DimensionLineColor = 0 ; DimensionLineExtend = 0.0 ; DimensionLinetype = "" ; DimensionLineWeight = -2 ; DimLine1Suppress = 0 ; DimLine2Suppress = 0 ; DimLineInside = 0 ; Document (RO) = #<VLA-OBJECT IAcadDocument 0000000027D8C468> ; EntityName (RO) = "AcDbRotatedDimension" ; EntityType (RO) = NIL ; ExtensionLineColor = 0 ; ExtensionLineExtend = 0.125 ; ExtensionLineOffset = 0.125 ; ExtensionLineWeight = -2 ; ExtLine1Linetype = "" ; ExtLine1Suppress = 0 ; ExtLine2Linetype = "" ; ExtLine2Suppress = 0 ; ExtLineFixedLen = 1.0 ; ExtLineFixedLenSuppress = 0 ; Fit = 3 ; ForceLineInside = 0 ; FractionFormat = 0 ; Handle (RO) = "20702" ; HasExtensionDictionary (RO) = 0 ; HorizontalTextPosition = 0 ; Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 0000000052DECB38> ; Layer = "0" ; LinearScaleFactor = 1.0 ; Linetype = "ByLayer" ; LinetypeScale = 1.0 ; Lineweight = -1 ; Material = "ByLayer" ; Measurement (RO) = 45.7393393773118 ; Normal = (0.0 0.0 1.0) ; ObjectID (RO) = 668216432 ; ObjectID32 (RO) = 668216432 ; ObjectName (RO) = "AcDbRotatedDimension" ; OwnerID (RO) = 668922848 ; OwnerID32 (RO) = 668922848 ; PlotStyleName = "ByLayer" ; PrimaryUnitsPrecision = 3 ; Rotation = 0.0 ; RoundDistance = 0.0 ; ScaleFactor = 1.0 ; StyleName = "Standard" ; SubUnitsFactor = NIL ; SubUnitsSuffix = NIL ; SuppressLeadingZeros = 0 ; SuppressTrailingZeros = 0 ; SuppressZeroFeet = -1 ; SuppressZeroInches = -1 ; TextColor = 0 ; TextFill = 0 ; TextFillColor = 0 ; TextGap = 0.25 ; TextHeight = 0.35 ; TextInside = 0 ; TextInsideAlign = 0 ; TextMovement = 0 ; TextOutsideAlign = -1 ; TextOverride = "" ; TextPosition = (59.5822222174528 27.7485201652591 0.0) ; TextPrefix = "" ; TextRotation = 0.0 ; TextStyle = "Standard" ; TextSuffix = "\"" ; ToleranceDisplay = 0 ; ToleranceHeightScale = 1.0 ; ToleranceJustification = 1 ; ToleranceLowerLimit = 0.0 ; TolerancePrecision = 3 ; ToleranceSuppressLeadingZeros = 0 ; ToleranceSuppressTrailingZeros = 0 ; ToleranceSuppressZeroFeet = -1 ; ToleranceSuppressZeroInches = -1 ; ToleranceUpperLimit = 0.0 ; TrueColor = #<VLA-OBJECT IAcadAcCmColor 0000000052F064F8> ; UnitsFormat = 2 ; VerticalTextPosition = 0 ; Visible = -1 ; ; Methods supported : ; ; ArrayPolar (3) ; ArrayRectangular (6) ; Copy () ; Delete () ; Erase () ; GetBoundingBox (2) ; GetExtensionDictionary () ; GetXData (3) ; Highlight (1) ; IntersectWith (2) ; Mirror (2) ; Mirror3D (3) ; Move (2) ; Rotate (2) ; Rotate3D (3) ; ScaleEntity (2) ; SetXData (2) ; TransformBy (1) ; Update ()
    1 point
  21. It looks like all of these ideas are good, but if you don't want to go through the trouble, I just use the laymcur command (of course i gave it a smaller alias for speed) and then you can select any object and it sets the current layer to whatever you select. I tried making lisps and scripts for what your doing but we use way to many layers for each dept. Hope it helps!
    1 point
  22. I think: (defun c:ll(/ lName) (if (and (setq lName(getstring T "\nSpecify layer name: ")) (tblsearch "LAYER" lName) ); end and (setvar "CLAYER" lName) (princ(strcat "\n<!> Can't to find layer \"" lName "\" <!>")) ); end if (princ) ); end of c:ll
    1 point
×
×
  • Create New...