Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation since 08/26/2022 in all areas

  1. @leonucadomi Give this a try: (defun c:foo (/ a b e h hp p x) ;; RJP » 2022-09-08 (cond ((and (setq e (car (entsel "\nPick source hatch: "))) (= "HATCH" (cdr (assoc 0 (entget e)))) (setq b (assoc 2 (entget e))) (setq e (vlax-ename->vla-object e)) (setq a (mapcar '(lambda (x) (list x (vlax-get e x))) '(associativehatch backgroundcolor elevation entitytransparency gradientangle gradientcentered gradientcolor1 gradientcolor2 gradientname hatchobjecttype hatchstyle isopenwidth layer linetype linetypescale lineweight material origin patternangle patterndouble patternscale patternspace plotstylename truecolor visible ) ) ) ) (setq hp (getvar 'hpname)) (setvar 'hpname (cdr b)) (while (setq p (getpoint)) (setq h (entlast)) (command "_.bhatch" p "") (cond ((not (equal h (setq h (entlast)))) (setq h (vlax-ename->vla-object h)) (foreach x a (vl-catch-all-apply 'vlax-put (list h (car x) (cadr x)))) ;; patternname (RO) cannot be set via vla for some reason ? ;; (setq h (entget (vlax-vla-object->ename h))) ;; (entmod (subst b (assoc 2 h) h)) ) ) ) (setvar 'hpname hp) ) ) (princ) )
    4 points
  2. (defun c:Test ( / lyn) (vlax-for obj (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))) (or (wcmatch (setq lyn (vla-get-name obj)) "*|*") (and (wcmatch lyn "AN_*,WS_*") (vla-put-Description obj (if (wcmatch lyn "AN_*") "Annotation" "Wall Structure")) ) ) ) (princ) ) (vl-load-com)
    3 points
  3. You do realize the reason for the lisp is because it isn't possible to create a hatch like this?
    3 points
  4. It is always a pity when negative feedback is posted about something that was given freely. The phrase 'looking a gift horse in the mouth' springs to mind. Did you read the working parameters at the beginning of the lisp file? Just open the file in a text reader, and you will see that the outcome is not a hatch. So how can you think that the scale can be altered? Perhaps you are voicing your discontent that the lisp does not do what you think it ought to do!
    3 points
  5. It didn't solve world hunger either!
    3 points
  6. This is an AutoCAD Forum, not a Manual Drafting Technique Forum. You need to find a manual drafting course if you seek to learn these methods. Seemingly, you have posted the instructions you seek, yet cannot understand. How do you expect someone to do any more on the internet? Ask a question on an AutoCAD Forum, you should expect AutoCAD solutions. You are getting extremely rude!
    3 points
  7. But you can learn and are more likely to get better help if you show that you want to learn rather than asking for a complete solution every time,
    3 points
  8. Macros can use lisp commands ^c^c(command "chprop" (ssget '((0 . "INSERT"))) "" "C" "ByBlock" "")
    3 points
  9. Give this a try: (defun c:foo (/ s) ;; RJP » 2022-09-09 ;; Generate vertical xlines on polyline vertexes (if (setq s (ssget '((0 . "LWPOLYLINE")))) (progn (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (foreach p (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget e)) (entmakex (list '(0 . "XLINE") '(100 . "AcDbEntity") '(67 . 0) '(8 . "XLINE") '(100 . "AcDbXline") p '(11 0.0 1.0 0.0) ) ) ) ) ;; Make layer not plot and color 128,128,128 (entmod (append (entget (tblobjname "LAYER" "XLINE")) '((290 . 0) (420 . 8421504)))) ) ) (princ) )
    3 points
  10. When you look carefully at "CABEÇALHO" the Ç is an extended character, ie a alt+num so ZWcad is trying to display with possibly a font that does not have Ç as a character. Bricscad was OK. If there is a way of defining the font to be used for display in ZWcad then it may display correct.
    3 points
  11. Draw a horizontal XLine, see where it intersects with the polylines, now look for the closest X-value of those intersect points with the polylines. Delete the temporary XLINE. (vl-load-com) ;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/ ;; draw a XLINE (defun drawxLine (pt vec) (entmakex (list (cons 0 "XLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbXline") (cons 10 pt) (cons 11 vec)))) ;; draw MText (defun drawM-Text (pt str) (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 1 str)))) (defun drawLine (p1 p2) (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Intersections - Lee Mac ;; http://www.lee-mac.com/intersectionfunctions.html ;; Returns a list of all points of intersection between two objects ;; for the given intersection mode. ;; ob1,ob2 - [vla] VLA-Objects ;; mod - [int] acextendoption enum of intersectwith method ;; acextendnone Do not extend either object ;; acextendthisentity Extend obj1 to meet obj2 ;; acextendotherentity Extend obj2 to meet obj1 ;; acextendboth Extend both objects (defun LM:intersections ( ob1 ob2 mod / lst rtn ) (if (and (vlax-method-applicable-p ob1 'intersectwith) (vlax-method-applicable-p ob2 'intersectwith) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) ) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst) ) ) ) (reverse rtn) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:npp ( / txt plines xline pt obj2 ins insx insx_sorted xl xr str) (princ "\nSelect ploylines") (setq plines (ssget (list (cons 0 "LINE,LWPOLYLINE,POLYLINE")))) (setq txt (entsel "\nSelect Text object: ")) (setq str (cdr (assoc 1 (entget (car txt))))) (setq pt (cdr (assoc 10 (entget (car txt))))) ;; draw a horizontal XLINE (setq xline (drawxLine pt (list 1.0 0.0))) ;; (list 1.0 0.0) draws to the right, (list 0.0 1.0) draws up thus vertical, ... ;; now look for intersect points of the XLINE with the polylines (setq insx (list)) ;; list of intersect points. Only the X value. (setq i 0) (repeat (sslength plines) (setq obj2 (ssname plines i)) (setq ins (LM:intersections (vlax-ename->vla-object xline) (vlax-ename->vla-object obj2) acextendnone)) ;; if there are intersect points, add the x-value to the list (foreach a ins (setq insx (append insx (list (nth 0 a) ))) ) (setq i (+ i 1)) ) ;; we no longer need the XLINE, we delete it (entdel xline) ;; sort the insx values from left to right (setq insx_sorted (vl-sort insx '<)) ;;(princ insx_sorted) ;; now we go looking for xl (left of the text) and xr (right of the text) (setq xl nil) (setq xr nil) (foreach a insx_sorted (if (< a (nth 0 pt)) ;; as long as the insert point is to the left, we'll replace xl (setq xl a) ) (if (and (not xr) (> a (nth 0 pt))) ;; the first insert point the right is the closest one (setq xr a) ) ) ;;(princ "\nLeft: ") ;;(princ xl) ;;(princ " - Right: ") ;;(princ xr) ;;(princ ) ;; draw line ;; we add the Y value of the Text object to get a point (drawLine (list xl (nth 1 pt)) (list xr (nth 1 pt))) ;; draw Mtexts (drawM-Text (list xl (nth 1 pt)) (strcat str " l1")) (drawM-Text (list xr (nth 1 pt)) (strcat str " r1")) )
    2 points
  12. That's to pass over external references' layers. Why are you asking for something and you are doing something else ? Anyway, just build the list as I did in the following program to make it working professionally. (defun c:Test ( / lst lyn ) (setq lst '(("AN_" "Annotation Layer - ") ("CH_" "Colour Hatch Layer - ") ) ) (vlax-for obj (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))) (or (wcmatch (setq lyn (vla-get-name obj)) "*|*") (and (setq fnd (assoc (substr lyn 1 3) lst)) (vla-put-Description obj (strcat (cadr fnd) lyn)) ) ) ) (princ) ) (vl-load-com)
    2 points
  13. 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
    2 points
  14. Something like this (setq obj (vlax-ename->vla-object (entlast))) (setq cpt (osnap (vlax-curve-getStartPoint obj) "gcen")) Thanks to Kent Cooper for the hint about gcen
    2 points
  15. Thank goodness AutoDesk did not design AutoCAD such that we could work smarter rather than harder. Were the pages of instructions you posted not clear enough?
    2 points
  16. Yep have that plus other stuff like rotate point. Yes for CIV3D cogo point. Also have a set surface style as a toolbar rather than using toolspace. Wrong one redid icons but gives you an idea. The black square is off. Civ3d Change point label style.lsp CIV3D point edit desc.lsp CIV3D Rotate point.lsp CIV3D create point.lsp CIV3D change point style.lsp Civ3d Change text style in labels.lsp CIV3D pt ht.lsp
    2 points
  17. Draw it in 3D then extract the 2D views.
    2 points
  18. Thank you so very much GP_ and Gu_xl for sharing a fantastic program. Sorry my "thanks" are 10 years late but I didn't see this the first time around. Truly great programming! I have already added to my toolbox.
    2 points
  19. If you have lines, change before all lines in polylines (PEDIT Multiple), you can try this... PATH_LENGTH.lsp
    2 points
  20. 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.
    2 points
  21. copy and paste.... I reckon it should be a double \\, if it is within " ",
    2 points
  22. 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
  23. 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)
    2 points
  24. Try this. So, the general way of doing it: - For every object I look if properties have been set, or if the property is ByLayer. I did this for Color, Line Width, Line Type. (If something is missing, tell me) - If the property is ByLayer, then I look at the layer, and what properties the layer has. Then I copy those layer properties to the object properties. - Last action is to set the layer to "0" See if it works, else let me know (Feel free to rename the command. I named it GLP for Get Layer Properties or something) ;; given a layer name, return a list of the properties of that layer. (defun layer_get_properties (Lay / ) laydata (entget (tblobjname "Layer" Lay)) ) (defun c:glp ( / ss i obj Lay ent layer_props col_obj col_lay wid_obj wid_lay typ_obj typ_lay) ;; 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)) ) (princ) )
    2 points
  25. You're welcome. Just add the entity name to the selection set as follows. (0 . "*TEXT,INSERT,LWPOLYLINE")
    2 points
  26. I assume your goal is to round up to a multiple of 5. Rem is helpful in rounding up. For example, (defun c:RoundUp ( / a b ) (setq a (getreal "\nEnter number: ")) (setq b ( + 5 (- a (rem a 5.)))) (princ "\Rounded up value = ") (princ b) (princ) )
    2 points
  27. If your using layouts then can draw grids on Viewports. Yes code by me.
    2 points
  28. I was going a step further and keep it in the family by just output to a table inside AutoCAD. but would really need a sample drawing.
    2 points
  29. Why not get the lisp to do all the work if you make a list of all text can sort, then group by dia into sub lists, then get length and add up so output to excel as result required. For me working on smarter excel defuns including write direct to excel say the results in this case. 40dia 1050 30dia 935 25dia 1234
    2 points
  30. You may have found this if you google, it does exactly what you want type Fxxx and it sets fillet to that radius, there is also Cxxx for circles and offset more could be added. There is one little quirk with the program because it uses error trapping you enter 1.5 as 1-5 the "-" is used as a decimal point, if you enter F1.5 it will error as the error check finds the "." and treats the error check method differently. ; Enter the filet radius as part of a command line entry f100, offset O234, circle c123-45, P123 for pline width ; note - is used for decimal point ; original code and methology by Alan H ; assistance and code that worked by Lee-Mac ; OCT 2015 ( (lambda nil (vl-load-com) (foreach obj (cdar (vlr-reactors :vlr-command-reactor)) (if (= "fillet-reactor" (vlr-data obj)) (vlr-remove obj) ) ) (vlr-command-reactor "fillet-reactor" '((:vlr-unknowncommand . fillet-reactor-callback))) ) ) (defun plwid ( / width oldwidth) (setq width (distof (substr com 2) 2)) (setq oldwidth (getvar 'plinewid)) (if (<= 0.0 width) (progn (setvar 'plinewid width ) (vla-sendcommand fillet-reactor-acdoc "_.pline ") (setvar 'plinewid oldwidth) ) ) ) (defun filletrad ( / rad) (setq rad (distof (substr com 2) 2)) (if (<= 0.0 rad) (progn (setvar 'filletrad rad) (vla-sendcommand fillet-reactor-acdoc "_.fillet ") ) ) ) (defun makecirc ( / rad) (setq rad (distof (substr com 2) 2)) (if (<= 0.0 rad) (progn (setvar 'circlerad rad) (vla-sendcommand fillet-reactor-acdoc "_.Circle ") ) ) ) (defun offdist ( / dist) (setq dist (distof (substr com 2) 2)) (if (<= 0.0 dist) (progn (setvar 'offsetdist dist) (vla-sendcommand fillet-reactor-acdoc "_.Offset ") ) ) ) (defun fillet-reactor-callback ( obj com ) (setq com (vl-string-translate "-" "." (strcase (car com)))) (cond ( (and (wcmatch com "~*[~F.0-9]*") (wcmatch com "F*") (wcmatch com "~F*F*") (wcmatch com "~*.*.*") ) ; and (filletrad) ) ( (and (wcmatch com "~*[~C.0-9]*") (wcmatch com "C*") (wcmatch com "~C*C*") (wcmatch com "~*.*.*") ) ;and (makecirc) ) ( (and (wcmatch com "~*[~O.0-9]*") (wcmatch com "O*") (wcmatch com "~O*O*") (wcmatch com "~*.*.*") ) ; and (offdist) ) ( (and (wcmatch com "~*[~P.0-9]*") (wcmatch com "P*") (wcmatch com "~P*P*") (wcmatch com "~*.*.*") ) ; and (plwid) ) ) ; master cond ) ; defun (princ) (or fillet-reactor-acdoc (setq fillet-reactor-acdoc (vla-get-activedocument (vlax-get-acad-object))) ) (princ) ; next Point or option keyword required.
    2 points
  31. @mhupp As usual - your lisp are effective,clear and as simple as it can be! I've added one more option - to let the user to choose the fillet radius (option FF): (defun C:F1 () (frx "0.0625")) (defun C:F2 () (frx "0.125")) (defun C:F3 () (frx "0.250")) (defun C:F4 () (frx "0.375")) (defun C:F5 () (frx "0.500")) (defun C:FF (/ FRad) (setq FRad (getreal "\nFillet Radius<0>: ")) (if (= FRad nil) (setq FRad 0) ) (frx (rtos FRad 2 3)) ) ;;----------------------------------------------------------------------;; ;; Quick Fillet with set radius (defun frx (x / *error* ofr) (defun *error* (errmsg) (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break")) (princ (strcat "\nError: " errmsg)) ) ; if (setvar 'filletrad ofr) ) (setvar "cmdecho" 0) (setq ofr (getvar 'filletrad)) (vl-cmdf "_.Fillet" "_Radius" x "_.Fillet" "_Multiple") (setvar "cmdecho" 1) (princ (strcat "\nFillet (radius=" x "): Select first entity or [Fillet Settings.../Polyline/Radius/Trim/Undo/Multiple]:")) (while (> (getvar 'cmdactive) 0) (command pause)) (setvar 'filletrad ofr) (princ) ) and again - well done!! Regards, aridzv.
    2 points
  32. This is what I use for common fillets. --edit Its set to run multiple but only draw back is if you miss click on like the 20th fillet and hit Esc it will undo all fillets. so if you mess up just exit out of the command and fix the one mistake. Also only temp overrides the fillet radius for the commands. --edit oops sorry Tombu (defun C:F1 () (frx "0.0625")) (defun C:F2 () (frx "0.125")) (defun C:F3 () (frx "0.250")) (defun C:F4 () (frx "0.375")) (defun C:F5 () (frx "0.500")) ;;----------------------------------------------------------------------;; ;; Quick Fillet with set radius (defun frx (x / *error* ofr) (defun *error* (errmsg) (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break")) (princ (strcat "\nError: " errmsg)) ) ; if (setvar 'filletrad ofr) ) (setvar "cmdecho" 0) (setq ofr (getvar 'filletrad)) (vl-cmdf "_.Fillet" "_Radius" x "_.Fillet" "_Multiple") (setvar "cmdecho" 1) (princ (strcat "\nFillet (radius=" x "): Select first entity or [Fillet Settings.../Polyline/Radius/Trim/Undo/Multiple]:")) (while (> (getvar 'cmdactive) 0) (command pause)) (setvar 'filletrad ofr) (princ) )
    2 points
  33. Those two are simple enough that you should try writing your first lisp. Set the value of the system variable FILLETRAD to 0.5 using setvar. Then start the FILLET command. If you have trouble post your code for more help. For the second one do you mean color from red to 255? One object or multiple? Do you need to filter a selection set for just those colored red? You get better help by describing exactly what you want. Search with Google or at the top of this page for what you need. Hundreds of fillet lisp threads out there like
    2 points
  34. FYI if you don't release "htmlfile" it could so some funky things after multiple copies. ;;MP ;;http://www.theswamp.org/index.php?topic=21764.msg263322#msg263322 (defun _GetClipBoardText( / htmlfile result ) (vlax-invoke (vlax-get (vlax-get (setq htmlfile (vlax-create-object "htmlfile")) 'ParentWindow) 'ClipBoardData) 'GetData "Text")) (vlax-release-object htmlfile) )
    2 points
  35. A quick answer This will copy ' --TEXTSTRING-- ' to the clipboard and you can then paste to a spreadsheet from there, this is perhaps the simplest solution though having to manually paste to excel add a little work (can also paste to wherever you want with this, a text editor, word processor, another drawing or wherever. CAD is off today, Sunday, but I think if you create your text string with a tab character in between 'cells' it might paste them into new cells - not something I have done though. Not sure about multiple lines. (vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'setData "TEXT" --TEXTSTRING-- ) You could also look at 'paste special' in excel, s there an option to paste CSV (comma separated values), and in that case you can create a temporary CSV file and paste that? Working with spreadsheets via AutoCAD.... a but tricky I understand but if you can save your text as a half way, like CSV it become a little easier but you need to do more work.
    2 points
  36. Use inkskape (free) or lightburn has a 30 day demo. -edit might need a little bit of clean up but faster then tracing. highfive.dwg
    2 points
  37. Thank you for kindly reply. I mistake copy and paste to my own lisp. missing the definition of findplotarea. So I check original code and find that and copy and paste to my own lisp. it is work. Thank you again.
    2 points
  38. All fixed and much cleaner and removed numerous lacks... My recommendation is to work with this code instead of my last one... (defun c:pts_along_pipe_trees_by_length-new ( / *error* pea cad doc reversepoly preprocess process bp dd ch c ell xll ) ; ell xll - lexical globals (vl-load-com) (defun *error* ( m ) (if pea (setvar 'peditaccept pea) ) (if (and doc (= 8 (logand 8 (getvar 'undoctl))) ) (vla-endundomark doc) ) (if doc (vla-regen doc acactiveviewport) ) (if m (prompt m) ) (princ) ) (defun reversepoly ( curve / rlw r3dp rhpl ) (defun rlw ( lw / e x1 x2 x3 x4 x5 x6 ) ;; by ElpanovEvgeniy (if (= (cdr (assoc 0 (setq e (entget lw)))) "LWPOLYLINE") (progn (foreach a1 e (cond ( (= (car a1) 10) (setq x2 (cons a1 x2)) ) ( (= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4)) ) ( (= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3)) ) ( (= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5)) ) ( (= (car a1) 210) (setq x6 (cons a1 x6)) ) ( t (setq x1 (cons a1 x1)) ) ) ) (entmod (append (reverse x1) (append (apply (function append) (apply (function mapcar) (cons (function list) (list x2 (cdr (reverse (cons (car x3) (reverse x3)))) (cdr (reverse (cons (car x4) (reverse x4)))) (cdr (reverse (cons (car x5) (reverse x5)))) ) ) ) ) x6 ) ) ) (entupd lw) ) ) ) ;; Reverse 3DPOLYLINE - Marko Ribar, d.i.a. (defun r3dp ( 3dp / r3dppol typ ) (defun r3dppol ( 3dp / v p pl sfa var ) (setq v 3dp) (while (= (cdr (assoc 0 (entget (setq v (entnext v))))) "VERTEX") (setq p (cdr (assoc 10 (entget v))) pl (cons p pl)) ) (setq pl (apply (function append) pl) sfa (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length pl))))) (vlax-safearray-fill sfa pl) (setq var (vlax-make-variant sfa)) (vla-put-coordinates (vlax-ename->vla-object 3dp) var) (entupd 3dp) ) (setq typ (vla-get-type (vlax-ename->vla-object 3dp))) (vla-put-type (vlax-ename->vla-object 3dp) acsimplepoly) (r3dppol 3dp) (if typ (vla-put-type (vlax-ename->vla-object 3dp) typ)) (entupd 3dp) ) ;; Reverse old heavy 2d POLYLINE - Marko Ribar, d.i.a. - sub functions by Roy at Theswamp.org (defun rhpl ( hpl / KGA_List_Divide_3 KGA_List_IndexSeqMakeLength KGA_Geom_PolylineReverse ) (defun KGA_List_Divide_3 ( lst / ret ) (repeat (/ (length lst) 3) (setq ret (cons (list (car lst) (cadr lst) (caddr lst)) ret) lst (cdddr lst)) ) (reverse ret) ) ; Make a zero based list of integers. (defun KGA_List_IndexSeqMakeLength ( len / ret ) (repeat (rem len 4) (setq ret (cons (setq len (1- len)) ret)) ) (repeat (/ len 4) (setq ret (vl-list* (- len 4) (- len 3) (- len 2) (- len 1) ret) len (- len 4)) ) ret ) ; Obj must be an "AcDb2dPolyline" of the acsimplepoly type or an "AcDbPolyline". (defun KGA_Geom_PolylineReverse ( obj / typ bulgeLst idxLst ptLst widLst conWid v vx ) (setq typ (vla-get-type obj)) (vla-put-type obj acsimplepoly) (setq ptLst (KGA_List_Divide_3 (vlax-get obj 'coordinates)) idxLst (KGA_List_IndexSeqMakeLength (1+ (length ptLst))) v (vlax-vla-object->ename obj)) (while (= (cdr (assoc 0 (setq vx (entget (setq v (entnext v)))))) "VERTEX") (setq widLst (cons (list (cdr (assoc 40 vx)) (cdr (assoc 41 vx))) widLst) bulgeLst (cons (cdr (assoc 42 vx)) bulgeLst)) ) (if (vl-catch-all-error-p (setq conWid (vl-catch-all-apply (function vla-get-constantwidth) (list obj)))) (mapcar (function (lambda ( idx pt bulge widSub ) (vla-put-coordinate obj idx (vlax-3d-point pt)) (vla-setbulge obj idx (- bulge)) (vla-setwidth obj idx (cadr widSub) (car widSub)) )) idxLst (reverse ptLst) (append (cdr bulgeLst) (list (car bulgeLst))) (append (cdr widLst) (list (car widLst))) ) (progn (mapcar (function (lambda ( idx pt bulge widSub ) (vla-put-coordinate obj idx (vlax-3d-point pt)) (vla-setbulge obj idx (- bulge)) )) idxLst (reverse ptLst) (append (cdr bulgeLst) (list (car bulgeLst))) ) (vla-put-constantwidth obj conWid) ) ) (if typ (vla-put-type obj typ)) ) (KGA_Geom_PolylineReverse (vlax-ename->vla-object hpl)) (entupd hpl) ) (cond ( (= (cdr (assoc 100 (reverse (entget curve)))) "AcDb2dPolyline") (rhpl curve) ) ( (= (cdr (assoc 100 (reverse (entget curve)))) "AcDb3dPolyline") (r3dp curve) ) ( (= (cdr (assoc 100 (reverse (entget curve)))) "AcDbPolyline") (rlw curve) ) ) ) (defun preprocess ( e / uniquevbl ss ex i b vbl sa coords ) (defun uniquevbl ( l ) (if l (cons (car l) (uniquevbl (vl-remove-if (function (lambda ( x ) (equal (caar l) (car x) 1e-6) )) (cdr l) ) ) ) ) ) (if (or e (setq ss (ssget "_A" (list (cons 0 "*POLYLINE"))))) (foreach pl (if e (list e) (vl-remove (function listp) (mapcar (function cadr) (ssnamex ss)))) (setq ex (entget pl)) (if (and (not e) (or (= (cdr (assoc 90 ex)) 1) (and (= (cdr (assoc 90 ex)) 2) (equal (cdr (assoc 10 ex)) (cdr (assoc 10 (reverse ex))) 1e-6) ) ) ) (entdel pl) ) (if (not (vlax-erased-p pl)) (progn (setq vbl nil) (setq i (1+ (fix (+ 0.1 (vlax-curve-getendparam pl))))) (while (<= 0 (setq i (1- i))) (setq vbl (cons (list (vlax-curve-getpointatparam pl (float i)) (if (not (vl-catch-all-error-p (setq b (vl-catch-all-apply (function vla-getbulge) (list (vlax-ename->vla-object pl) i))))) b)) vbl)) ) (setq vbl (uniquevbl vbl)) (if (= (cdr (assoc 0 ex)) "LWPOLYLINE") (progn (setq vbl (mapcar (function (lambda ( x ) (list (trans (car x) 0 (cdr (assoc 210 ex))) (cadr x)))) vbl)) (setq ex (subst (cons 90 (length vbl)) (assoc 90 ex) ex)) (setq ex (append (vl-remove-if (function (lambda ( x ) (vl-position (car x) (list 10 40 41 42 91 210)) )) ex ) (apply (function append) (mapcar (function (lambda ( x ) (list (cons 10 (car x)) (cons 40 0.0) (cons 41 0.0) (cons 42 (cadr x)) (cons 91 0.0) ) )) vbl ) ) (list (assoc 210 ex)) ) ) (entupd (cdr (assoc -1 (entmod ex)))) ) (progn (setq sa (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length (setq coords (apply (function append) (mapcar (function car) vbl)))))))) (vla-put-coordinates (vlax-ename->vla-object pl) (vlax-make-variant (vlax-safearray-fill sa coords))) ) ) ) ) ) ) ) (defun process ( dd qt pt / proclst makepoly processlst ss i el e d len f par lst pp ) (defun proclst ( e dd qt pt / pp par ddd ) (if (and (setq par (float (fix (+ 0.1 (vlax-curve-getparamatpoint e (trans qt 1 0)))))) (setq pp (vlax-curve-getpointatparam e par)) ) (progn (setq ddd (- dd (vlax-curve-getdistatpoint e pp))) (if (> ddd 0) (setq processlst (cons (list ddd qt pt) processlst)) ) ) ) ) (defun makepoly ( e p c / polyprocess s eel el pl1 pl2 pl3 vl i qtt ) (defun polyprocess ( e q c / f ln ep i pbl par b arcll arclx a ex ) (setq ln (vlax-curve-getdistatparam e (setq ep (vlax-curve-getendparam e)))) (repeat (setq i (1+ (fix (+ 0.1 ep)))) (setq pbl (cons (list (vlax-curve-getpointatparam e (float (setq i (1- i)))) (if (not (vl-catch-all-error-p (setq b (vl-catch-all-apply (function vla-getbulge) (list (vlax-ename->vla-object e) i))))) b) ) pbl ) ) ) (setq par (vlax-curve-getparamatpoint e (vlax-curve-getclosestpointto e q))) (if (equal par ep 1e-6) (progn (reversepoly e) (entupd e) (setq f t) ) ) (setq pbl nil) (repeat (setq i (1+ (fix (+ 0.1 ep)))) (setq pbl (cons (list (vlax-curve-getpointatparam e (float (setq i (1- i)))) (if (not (vl-catch-all-error-p (setq b (vl-catch-all-apply (function vla-getbulge) (list (vlax-ename->vla-object e) i))))) b) ) pbl ) ) ) (setq par (vlax-curve-getparamatpoint e (vlax-curve-getclosestpointto e q))) (if (and par pbl) (progn (if (and (vlax-curve-getpointatparam e (float (fix (1+ par)))) (setq b (cadr (nth (fix par) pbl))) ) (progn (setq arcll (- (vlax-curve-getdistatparam e (float (fix (1+ par)))) (vlax-curve-getdistatparam e (float (fix par))) ) ) (setq arclx (- (vlax-curve-getdistatparam e par) (vlax-curve-getdistatparam e (float (fix par))) ) ) (setq a (* 4.0 (atan b))) (setq b (/ (sin (/ (* (/ a arcll) arclx) 4.0)) (cos (/ (* (/ a arcll) arclx) 4.0)))) ) ) (setq pbl (reverse (member (nth (fix par) pbl) (reverse pbl)))) (setq pbl (append (subst (list (car (last pbl)) b) (last pbl) pbl) (list (list q nil)))) (setq ex (entget e)) (if f (progn (reversepoly e) (entupd e) ) ) (if (vl-some (function numberp) (mapcar (function cadr) pbl)) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length pbl)) (cons 70 (* 128 (getvar 'plinegen))) (assoc 38 ex) ) (apply (function append) (mapcar (function (lambda ( x ) (list (cons 10 (trans (car x) 0 (cdr (assoc 210 ex)))) (cons 40 0.0) (cons 41 0.0) (cons 42 (if (cadr x) (cadr x) 0.0)) (cons 91 0.0) ) )) pbl ) ) (list (assoc 210 ex) (cons 62 c) ) ) ) (progn (vl-cmdf "_.3DPOLY") (foreach pb pbl (vl-cmdf "_non" (trans (car pb) 0 1)) ) (vl-cmdf "") (entupd (cdr (assoc -1 (entmod (if (assoc 62 (setq ex (entget (entlast)))) (subst (cons 62 c) (assoc 62 ex) ex) (append ex (list (cons 62 c))) ) ) ) ) ) ) ) ) ) ) (setq xll (cons (setq pl1 (polyprocess e p c)) xll)) (setq qtt (trans (vlax-curve-getpointatparam pl1 0.0) 0 1)) (if (and (not (equal (trans qtt 1 0) (trans bp 1 0) 1e-6)) (setq s (ssget "_C" (mapcar (function +) (list -1e-3 -1e-3) qtt) (mapcar (function +) (list 1e-3 1e-3) qtt) (list (cons 0 "*POLYLINE")))) (> (sslength s) 0) ) (progn (if (ssmemb e s) (ssdel e s) ) (if (ssmemb pl1 s) (ssdel pl1 s) ) (foreach x xll (if (and s (ssmemb x s)) (ssdel x s) ) ) (if (and s (> (sslength s) 0)) (setq eel (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex s)))) ) ) ) (foreach ee eel (setq f nil) (setq pl3 (vlax-vla-object->ename (vla-copy (vlax-ename->vla-object pl1)))) (if (< (vlax-curve-getparamatpoint ee (trans bp 1 0)) (vlax-curve-getparamatpoint ee (trans qtt 1 0))) (setq pl2 (polyprocess ee qtt c)) (progn (reversepoly ee) (entupd ee) (setq pl2 (polyprocess ee qtt c)) (setq f t) ) ) (if f (progn (reversepoly ee) (entupd ee) ) ) (setq el (entlast)) (if (and pl2 pl3) (progn ;| (vl-cmdf "_.PEDIT" "_M" (ssadd pl2 (ssadd pl3)) "" "_J") (while (< 0 (getvar 'cmdactive)) (vl-cmdf "") ) |; (vl-cmdf "_.JOIN" (ssadd pl2 (ssadd pl3)) "") (if (not (eq el (entlast))) (setq el (entlast)) (setq el (if pl2 pl2 pl3)) ) (preprocess el) (if (vl-position pl1 xll) (setq xll (subst el pl1 xll)) (setq xll (cons el xll)) ) ) ) ) (if (and eel pl1 (not (vlax-erased-p pl1))) (entdel pl1) ) ) (if (and (setq ss (ssget "_C" (mapcar (function +) (list -1e-3 -1e-3) (setq qt (osnap qt "_nea"))) (mapcar (function +) (list 1e-3 1e-3) qt) (list (cons 0 "*POLYLINE")))) (progn (foreach x (append xll ell) (if (ssmemb x ss) (ssdel x ss) ) ) (and ss (> (sslength ss) 0)) ) ) (progn (repeat (setq i (sslength ss)) (if (and (not (vl-position (setq e (ssname ss (setq i (1- i)))) ell)) (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getstartpoint) (list e)))) ) (setq el (cons (list e pt) el)) ) ) (if el (progn (setq ell (append (vl-remove-if (function (lambda ( x ) (vl-position x xll))) (mapcar (function car) el)) ell)) (foreach ep el (setq f nil lst nil) (setq e (car ep) pt (cadr ep)) (setq d (vlax-curve-getdistatpoint e (trans qt 1 0))) (setq len (vlax-curve-getdistatparam e (vlax-curve-getendparam e))) (if (equal d len 1e-6) (progn (reversepoly e) (entupd e) (setq f t) ) ) (setq d (vlax-curve-getdistatpoint e (trans qt 1 0))) (repeat (setq par (fix (+ 0.1 (vlax-curve-getendparam e)))) (setq lst (cons (trans (vlax-curve-getpointatparam e (float (1+ (fix (setq par (1- par)))))) 0 1) lst ) ) ) (foreach p lst (proclst e dd p pt) ) (cond ( (and (zerop d) (= (cdr (assoc 90 (entget e))) 2) (vlax-curve-getpointatdist e dd) ) (if (and e (not (vlax-erased-p e)) (setq pp (vlax-curve-getpointatdist e dd))) (progn (entmake (list (cons 0 "POINT") (cons 10 pp))) (if (= ch "Yes") (makepoly e pp c)) ) ) ) ( (<= 0.0 (+ d dd) len) (if (and e (not (vlax-erased-p e)) (setq pp (vlax-curve-getpointatdist e (+ d dd)))) (progn (entmake (list (cons 0 "POINT") (cons 10 pp))) (if (= ch "Yes") (makepoly e pp c)) ) ) ) ) (if f (progn (reversepoly e) (entupd e) ) ) ) ) ) (foreach lst processlst (process (car lst) (cadr lst) (caddr lst)) ) ) ) ) (setq pea (getvar 'peditaccept)) (setvar 'peditaccept 1) (if (and (setq doc (vla-get-activedocument (setq cad (vlax-get-acad-object)))) (= 8 (logand 8 (getvar 'undoctl))) ) (vla-endundomark doc) ) (if doc (vla-startundomark doc) ) (if (and (setq bp (getpoint "\nPick or specify main base point : ")) (not (initget 6)) (setq dd (cond ( (not (setq dd (getdist bp "\nPick or specify length from base point for spread around <1.0> : "))) 1.0 ) ( t dd ))) (not (initget "Yes No")) (setq ch (cond ( (not (setq ch (getkword "\nDo you want to overmake new polylines up to resulting points [Yes / No] <Yes> : "))) "Yes" ) ( t ch ))) (if (= ch "Yes") (progn (initget 6) (setq c (cond ( (not (setq c (getint "\nSpecify color for new polylines <3> : "))) 3 ) ( t c ))) ) t ) ) (progn (if cad (vla-zoomextents cad) ) (preprocess nil) (process dd bp bp) ) ) (*error* nil) ) Regards, M.R. HTH.
    2 points
  39. 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.
    2 points
  40. 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
    2 points
  41. "Thanks" are valid forever...
    1 point
  42. There is a couple of people around who hint loudly they can decompile a vlx etc so will never get rid of a hacker and for what reason ? How did they end up with your program ? I still believe in the 99.999% rule "don't have a clue how to crack". What good is a duct program when I am CIVIL. I have got the phone call software is not working they were trying to install on a friends computer rather than pay, had a security check in code. Back to protect and Kelv they are very old protection programs and easy to crack so would not go down that path, as I said old so you would need like a 10 year old pc, XP maybe to run. There is some run 32 bit program solutions but I have never had success. Kelvinator may be a 16bit program. Unfortunately the LISP2C program had a quite death, was possibly a better way to go as it made C code from lisp, which could be compiled into say now .NET, an old 16bit-program.
    1 point
  43. I reckon you can change it, this line here changes the color. (vla-put-Color objBlock 0) Perhaps if you put a ; at the start of the lines that change for example layer and linetype, that might do what you want? You'd have to work out what to do from there though. The ; stops that line being implemented in the LISP
    1 point
  44. 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
  45. One more revision... I hope it's now even better than before... pts_along_pipe_trees_by_length.lsp
    1 point
  46. I don't have Auto save turned on if you do something wrong in say a custom menu and it screws up the menus, closing Cad means you return to the screwed up workspace and its a pain to have to go into CUI and look for all the CUIX files that no longer exist, I have had "File" and that was it all menu's gone !
    1 point
  47. @BIGAL Basically have the same code for offset so F for fillets O for offsets. Couldn't get your code to work (must be doing something wrong or BricsCAD) or my code either but matches the same outputs. --edit prob don't need the split string function. ; Enter the filet radius as part of a command line entry f100, O234 for offset, c123.45 for circle, P123 for pline width ; original code and methology by Alan H ; assistance and code that worked by Lee-Mac ; OCT 2015 ((lambda nil (vl-load-com) (foreach obj (cdar (vlr-reactors :vlr-command-reactor)) (if (= "fillet-reactor" (vlr-data obj)) (vlr-remove obj) ) ) (vlr-command-reactor "fillet-reactor" '((:vlr-unknowncommand . fillet-reactor-callback))) ) ) (defun plwid (/ oldwidth) (setq oldwidth (getvar 'plinewid)) (setvar 'plinewid num) (vla-sendcommand fillet-reactor-acdoc "_.pline ") (setvar 'plinewid oldwidth) ) (defun filletrad () (setvar 'filletrad num) (vla-sendcommand fillet-reactor-acdoc "_.fillet ") ) (defun makecirc () (setvar 'circlerad num) (vla-sendcommand fillet-reactor-acdoc "_.Circle ") ) (defun offdist () (setvar 'offsetdist num) (vla-sendcommand fillet-reactor-acdoc "_.Offset ") ) (defun fillet-reactor-callback (obj com / num) (setq com (car com)) (cond ((and (eq (strcase (substr com 1 1)) "F") (numberp (setq num (distof (substr com 2)))) (<= 0.0 num) ) ; and (filletrad) ) ((and (eq (strcase (substr com 1 1)) "C") (numberp (setq num (distof (substr com 2)))) (<= 0.0 num) ) ;and (makecirc) ) ((and (eq (strcase (substr com 1 1)) "O") (numberp (setq num (distof (substr com 2)))) (<= 0.0 num) ) ; and (offdist) ) ((and (eq (strcase (substr com 1 1)) "P") (numberp (setq num (distof (substr com 2)))) (<= 0.0 num) ) ; and (plwid) ) ) ; master cond ) ; defun (or fillet-reactor-acdoc (setq fillet-reactor-acdoc (vla-get-activedocument (vlax-get-acad-object))) )
    1 point
  48. Still working on a expanded excel library functions so could do select text then select cell and it will PUT value direct not using clipboard. Stumbled on real nice get cell address. So if say make a list or selection set of text could do a multi PUT. For multi need extra question go right or down. Watch this space, very close. This is Acad / Bricscad asking excel to select a range and return the cell range. Big thanks to FIXO code unfortunately no longer with us did lots of excel stuff. So the get from is done Importing X and Y Coordinates for Custom made blocks from excel. - Autodesk Community - AutoCAD https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/importing-x-and-y-coordinates-for-custom-made-blocks-from-excel/td-p/11373585
    1 point
×
×
  • Create New...