Jump to content

Leaderboard

  1. pkenewell

    pkenewell

    Community Member


    • Points

      7

    • Posts

      519


  2. fuccaro

    fuccaro

    Moderator


    • Points

      6

    • Posts

      1,641


  3. Tsuky

    Tsuky

    Community Member


    • Points

      4

    • Posts

      201


  4. SLW210

    SLW210

    Moderator


    • Points

      4

    • Posts

      10,446


Popular Content

Showing content with the highest reputation since 04/16/2024 in all areas

  1. Another Example: I wrote this back in the 90's (believe it or not) and still maintain it for drawing ANSI plug gages. It fully draws everything with Visual LISP. I Don't even use it anymore, but it's a good resource that I use as a test bed for trying out better code, and keeping myself exercised in LISP programming.
    2 points
  2. There are many ways to skin this cat (cond ((and txt (wcmatch (cdr (assoc 0 (entget txt))) "*TEXT")) also works.
    2 points
  3. @Tsuky Good Job. I did notice a bug however, and I am not sure why it is behaving like this. Try running your command on an MTEXT object that has only 1 field with no other text around it. For some reason it will kill the Field object, leaving behind "####" or "---". EDIT: I figured it out - thanks to reviewing Lee Mac's FieldArithmetic program. You need to clear the text contents before re-adding them for some reason. (defun c:foo ( / ss n ent obj old new) (defun string-subst (nam_obj / value_string nbs tmp_nbs) (setq value_string (vla-fieldcode nam_obj) nbs 0) (while nbs (if (setq nbs (vl-string-search "%pr0" value_string (setq tmp_nbs nbs))) (setq value_string (vl-string-subst "%pr2" "%pr0" value_string tmp_nbs) nbs (1+ nbs) ) ) ) (vlax-put nam_obj 'TextString "") ;; Add this line (vlax-put nam_obj 'TextString value_string) ) (setq ss (ssget '((0 . "MTEXT")))) (cond (ss (repeat (setq n (sslength ss)) (setq ent (ssname ss (setq n (1- n))) obj (vlax-ename->vla-object ent) ) (string-subst obj) ) ) ) (prin1) )
    2 points
  4. Pretty much the same here and most other companies. I have lots of convincing to do to get free apps from the Autodesk store, something from anonymous non opensource isn't going to happen. Sometimes Windows will flag the msi files and IT will have to research the source, so can take a while. AFAIK, the issue with things like DOSLIB, OpenDCL, etc. everyone using the codes needs them installed.
    2 points
  5. The other way you can do it is by using nentselp. This allows you to access any entity within that block, no matter how nested they are. The catch is, you will need to click on the exact object within that block that you want to extract.
    1 point
  6. you can get list of attributes by add these 2 words (vlax-safearray->list (vlax-variant-value ~~~~~~~)) like this (vlax-safearray->list (vlax-variant-value (vlax-invoke-method (vlax-ename->vla-object (car (entsel "\nSelect SHEET"))) 'GetAttributes))) and dump it first one like this (vlax-dump-object (car (vlax-safearray->list (vlax-variant-value (vlax-invoke-method (vlax-ename->vla-object (car (entsel "\nSelect SHEET"))) 'GetAttributes)))))
    1 point
  7. I don't know about the OP, but I tried that and it didn't work. I also tried using (entupd) and that also doesn't change it even thought the actual entity list shows the changed values. Also, if you use the properties pallet and update the closed status, it updates everything correctly.
    1 point
  8. Honestly - I attempted at one time to make code for altering splines with (entmake), trying to account for all the changes. I failed miserably! Using the activeX methods and properties are MUCH easier.
    1 point
  9. Cad's entmake lisp is probably the closest thing your going to get. you just select what you want and it will generate the entmake code. Why not have a template drawing or lee mac's Steal lisp with the steal all option?
    1 point
  10. Once you get the DWG, you can use ENTGET to transform an entity in a list of DXF codes. Yes, you could walk in the AutoCAD's database and transform the entities one by one. But probable you should include the nongraphic entities too. Say if a line must be placed on an inexistent layer, AutoCAD will create that layer "on the fly". But you must deal with text styles, dimstyles and so on. Also if there are inserts, you must define the blocks first. About the Xrefs -better don't even mention it. To make the long story short: in theory it's possible, for some drawings it is easier, for other ones is more complicated.
    1 point
  11. I have moved your thread to the AutoLISP, Visual LISP & DCL Forum.
    1 point
  12. guys, You have been most helpful. I now have further things and leads to study. Thank You very much
    1 point
  13. Good comment Johnathan, like the old saying crawl, walk then run. The array part can still be used.
    1 point
  14. I think it's more of a practice. It's their first code after all. Always good to start somewhere.
    1 point
  15. Another why not draw 1 and use array ? (defun c:stamps (/ w h c r a b pt) (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (setq ans (AH:getvalsm (list "Enter values " "Width " 5 4 "100" "height " 5 4 "100" "Number columns" 5 4 "5" "Number rows" 5 4 "5" "Dist between columns" 5 4 "20" "dist between rows" 5 4 "20"))) (setq w (atof (nth 0 ans)) h (atof (nth 1 ans)) c (atoi (nth 2 ans)) r (atoi (nth 3 ans)) a (atof (nth 4 ans)) b (atof (nth 5 ans)) ) (setq pt (getpoint "\nPick lower left point for rectang ")) (command "_RECTANG" "_non" pt "_non" (list (+ (car pt) w) (+ (cadr pt) h))) (command "array" (entlast) "" "Rectangular" r c (+ b h) (+ a w) ) (princ) ) Multi GETVALS.lsp
    1 point
  16. Just as the above has shown, it completely works. There are other ways as well, but since you have just started using AutoLISP, I thought I'd leave some comments: (defun c:stamps ( / _getfunc a b c h offset r start w) (defun _getfunc (fnc msg bit) ;; Define a function to make use of initget. ;| Initget is a function which can be used to restrict numerical user inputs: https://help.autodesk.com/view/OARX/2023/ENU/?guid=GUID-9ED8841B-5C1D-4B3F-9F3B-84A4408A6BBF |; (initget bit) (fnc msg) ) (and ;| Using 'and' introduces the short-circuit evaluation, in which conditional processsing stops as soon as the first value returns nil. All get- functions (except getstring) returns nil upon pressing Enter |; (setq w (_getfunc getdist "\nEnter the width of the rectangle <exit>: " 6)) ;; A value of 6 (bits 2 and 4) ensure that the user enters a positive value and not 0 (setq h (_getfunc getdist "\nEnter the height of the rectangle <exit>: " 6)) ;; Using getdist allow the user to also specify two points to define the distance. (setq c (_getfunc getint "\nEnter the number of columns <exit>: " 6)) (setq r (_getfunc getint "\nEnter the number of rows <exit>: " 6)) (setq a (_getfunc getdist "\nEnter the distance between columns <exit>: " 4)) (setq b (_getfunc getdist "\nEnter the distance between rows <exit>: " 4)) ;; Comment one line or the other depending on the insertion point being located at (0.0 0.0), or to a point specified by the user. ;(setq start '(0.0 0.0)) (setq start (getpoint "\nSpecify point to place rectangles <exit>: ")) (progn (setq offset '(0.0 0.0)) (repeat r (repeat c (command "_RECTANG" "_non" (mapcar '+ start offset) "_non" (mapcar '+ start offset (list w h))) (while (not (zerop (getvar "cmdactive"))) (command "")) ;; This ensure that the Space/Enter key keeps getting pressed until the command is over. ;; Not entirely necessary, but I always use it for good practise. (setq offset (list (+ (car offset) w a) (cadr offset))) ) (setq offset (list 0.0 (+ (cadr offset) h b))) ) ) ) (princ) ;; Exit the command quitely. Always use this, good common AutoLISP programming practise for a clean command line exit. )
    1 point
  17. another way as fuccaro stated using wildcards: (cond ((and txt (wcmatch (cdr (assoc 0 (entget txt))) "TEXT,MTEXT"))
    1 point
  18. Try this, Express Tools required (setq scale 10.0 ang 0.0) (if (setq :imm (acet-ui-getfile "Select Image" (getvar"dwgprefix") "jpg;*;png;tif;bmp" "" 288)) (command "_.-attach" :imm pause scale ang) )
    1 point
  19. i tweaked the code to include the (or...) as per Steven P suggestion and now it works perfect thanks for the help guys. much appreciated
    1 point
  20. Hi, My solution in lisp to select based on object data fields. But you also have an excellent plugin to install HERE Sel_By_OD.lsp
    1 point
  21. I wrote the Lisp above to deal with texts according to OP's request. So the program checks first if there is anything selected, next it looks for the type of the selected entity. Yes, you can expand that second check by adding some ORs, or you could use wildcards. Another option could be to skip all these checks. Of course, in this case it is the user's responsibility to make correct selections.
    1 point
  22. Fuccaros code tests for text being selected, if you want text OR mtext you need to change the check line: (cond ((and txt (= (cdr (assoc 0 (entget txt))) "TEXT")) to include (or....) Untested replace with something like this: (cond ((and txt (or (= (cdr (assoc 0 (entget txt))) "TEXT") (= (cdr (assoc 0 (entget txt))) "MTEXT") ) ; endor ) ; end and
    1 point
  23. @Lee Mac Wrote a "Chain Select" routine that works really well. https://www.lee-mac.com/chainsel.html I believe you could modify Line 29 to a different tolerance if needed. .... (setq fz 1e-8) ;; Point comparison tolerance"
    1 point
  24. This should work. (defun c:pp() (setq txt (car (entsel))) (cond ((and txt (= (cdr (assoc 0 (entget txt))) "TEXT")) (command "copy" txt "" pause pause) (command "textedit" "L" "") ) (t "wrong selection")) ) It can be improved...
    1 point
  25. @pkenewell Very good remark! I had only briefly tested my function and I missed this situation. Thank you for your correction which resolves this problem.
    1 point
  26. pkenewell. I've just tested it. Indeed, if the MTEXT contains only 1 field, it goes to ####. congratulations on seeing this bug. Sincerely Fab91
    1 point
  27. Perhaps something like this - (defun sortit ( lst ) (mapcar '(lambda ( n ) (nth n lst)) (vl-sort-i (mapcar '(lambda ( x ) (LM:str->lst (cdr x) "-")) lst) (function (lambda ( a b / x y ) (while (and a b (= (car a) (car b))) (setq a (cdr a) b (cdr b) ) ) (cond ( (null a)) ( (null b) nil) ( (and (numberp (setq x (read (car a)))) (numberp (setq y (read (car b)))) ) (< x y) ) ( (numberp x)) ( (numberp y) nil) ( (< (car a) (car b))) ) ) ) ) ) ) ;; String to List - Lee Mac ;; Separates a string using a given delimiter ;; str - [str] String to process ;; del - [str] Delimiter by which to separate the string ;; Returns: [lst] List of strings (defun LM:str->lst ( str del / pos ) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del)) (list str) ) )
    1 point
  28. Ok, You have multi lines or multi row/column in your Mtext. Try this (defun c:foo ( / ss n ent obj old new) (defun string-subst (nam_obj / value_string nbs tmp_nbs) (setq value_string (vla-fieldcode nam_obj) nbs 0) (while nbs (if (setq nbs (vl-string-search "%pr0" value_string (setq tmp_nbs nbs))) (setq value_string (vl-string-subst "%pr2" "%pr0" value_string tmp_nbs) nbs (1+ nbs) ) ) ) (vlax-put nam_obj 'TextString value_string) ) (setq ss (ssget '((0 . "MTEXT")))) (cond (ss (repeat (setq n (sslength ss)) (setq ent (ssname ss (setq n (1- n))) obj (vlax-ename->vla-object ent) ) (string-subst obj) ) ) ) (prin1) )
    1 point
  29. Please use Code Tags in the future. (<> in the editor toolbar)
    1 point
  30. Pretty much the only software is the ones on their list, one off installs aren't allowed
    1 point
  31. A start whith this? (defun c:foo ( / ss n ent obj old new) (setq ss (ssget '((0 . "MTEXT")))) (cond (ss (repeat (setq n (sslength ss)) (setq ent (ssname ss (setq n (1- n))) obj (vlax-ename->vla-object ent) old (vla-fieldcode obj) new (vl-string-subst "%pr2" "%pr0" old) ) (vlax-put obj 'TextString new) ) ) ) (prin1) )
    1 point
  32. (defun c:XDTB_DWGCUT (/ dynpt e lastpnt myerr olderr pts ss ss1 tf) (defun _callback (dynpt) (xdrx_entity_move ss lastpnt dynpt) (setq lastpnt dynpt) ) (defun _move (ss) (setq lastpnt (trans (xd::geom:get9pt ss 5)1 0)) (xdrx_pointmonitor "_callback" ss) (initget 1) (getpoint (xdrx-string-multilanguage "\n插入点:""\nInsert Point:")) (xdrx_pointmonitor) ) (defun myerr (msg) (princ "\n*cancel") (xdrx_end) (vl-cmdf ".undo" 1) (setq *error* olderr) (princ) ) (xdrx_begin) (setq olderr *error*) (setq *error* myerr) (setq pts nil) (if (setq e (car (xdrx_entsel (xdrx-string-multilanguage "\n请拾取裁剪边界<退出>:""\nPlease pick the cropping boundary <Exit>:") '((0 . "lwpolyline,circle,ellipse,spline")) ) ) ) (progn (setq tf (xdrx-document-safezoom e)) (setq pts (xdrx_getsamplept e) ss (ssget "cp" (xd::pnts:wcs2ucs pts)) ) (if (setq ss1 (xdrx_geom_clipboundary ss e t t)) (progn (if tf (xdrx_document_zoomprevious) ) (ssadd e ss1) (_move ss1) ) ) ) ) (setq *error* olderr) (xdrx_end) (princ) ) [XDrX-PlugIn(83)] DWG cutting (theswamp.org) https://www.theswamp.org/index.php?topic=59019.0
    1 point
  33. Just a guess but ssget didn't find anything so ssbo is nil. When calling sslenght on line 479 its looking at nil rather then a selection set and errors. Add an if in front of the ssget. So if it doesn't find anything it skips the code. (if (setq ssbo (ssget '((0 . "LWPOLYLINE") (8 . "BATAS BIDANG")))) (repeat (setq slbo (sslength ssbo)) ... ... (setq klikpolykor (list entbo korbo)) ) ) -edit Its best to post the whole code. Something else could be happening. Its like taking your car the the mechanic but only letting him look at it from 20' away or at a picture and then asking whats wrong.
    1 point
  34. Hi Satya, Did you work this out? As a stand alone line it works on my CAD.
    1 point
  35. Just another way of doing it without the i variable. (if (setq A3 (ssget "_X" '((2 . "SW_CEN*")))) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex A3))) (entdel e) ) ) set up a function like this.
    1 point
  36. Sounds simple for the best help post a dwg with a couple of blocks.
    1 point
  37. You could create a program using my Quick Field utility to perform this task.
    1 point
  38. What is that "field to finish" you are talking about? Is a entity specific to Civil 3D? You can try the script approach - for editing please note that can access the last added entity by inputing "_L" when asked for selection. The example below will add a polyline on the script and smooth it in next step. _PLINE 0,0 50,100 100,100 100,50 _PEDIT _L _F _REGEN
    1 point
×
×
  • Create New...