Jump to content

Leaderboard

  1. BIGAL

    BIGAL

    Trusted Member


    • Points

      27

    • Posts

      15,170


  2. Steven P

    Steven P

    Community Member


    • Points

      22

    • Posts

      551


  3. mhupp

    mhupp

    Community Member


    • Points

      22

    • Posts

      579


  4. ronjonp

    ronjonp

    Trusted Member


    • Points

      21

    • Posts

      1,989


Popular Content

Showing content with the highest reputation since 12/26/2021 in all areas

  1. Here are some more examples, along with a quick performance comparison.
    5 points
  2. The upgrade has now completed successfully, and we are now running the most recent version of Invision Community. The most obvious change is that the Rank system, which has been a part of this forum for many years, is replaced with a new system called Achievements. The new system is much more flexible. Ranks were based purely on the number of posts that members made. Achievements are based on the number of points acrued. Points are awarded for lots of different things, not just content posting. For example, points are earned for having followers, getting positive reactions etc. In addition to the ranks awarded through achievements, members can also earn badges for passing significant milestones and for excellent work. All of this means that your profile looks a little different than it did before. There are also some changes under the hood, but those shouldn't make any significant difference to your experience. As usual, if you spot anything that doesn't look right, post in this thread to let me know.
    4 points
  3. @Emmanuel Delay your code places the dimension on the opposite side of the line when ar is to the left of al and the aligned dimension goes from left to right. Here's a before and after shot. I avoid using angles although sometimes it is easier. Here's a modified version of your code using vectors. (defun deg2rad (ang / ) (/ (* PI ang) 180.0) ) (defun rad2deg ( ang / ) (/ (* 180.0 ang) PI) ) ;; midpoint of 2 given points (defun mid ( pt1 pt2 / ) (mapcar '(lambda (x y) (+ (* 0.5 x) (* 0.5 y))) pt1 pt2 ) ) ;;; Calculate unit vector of vector a (defun uvec (a / d) (setq d (distance '(0 0 0) a) a (mapcar '/ a (list d d d)) ) ) ; Compute the dot product of 2 vectors a and b (defun dot ( a b / dd) (setq dd (mapcar '* a b)) (setq dd (+ (nth 0 dd) (nth 1 dd) (nth 2 dd))) ) ;end of dot (defun c:test2 ( / sel ent txp al ar mp uALR s txpp uvt tp ) (princ "\nDistance DIM: ") (setq dist (getreal)) (while (setq sel (entsel "\nSelect DIM: ")) (setq ent (car sel )) (setq txp (cdr (assoc 10 (entget ent)))) (setq al (cdr (assoc 13 (entget ent)))) (setq ar (cdr (assoc 14 (entget ent)))) ;;; (setq ang1 (angle al ar)) ;;; (setq mp (mid al ar)) ;;; ;;; (setq ang2 (angle mp txp)) ;;; ;;; (if (< ang1 ang2) ;;; (setq tp (polar mp (+ ang1 (deg2rad 90.0)) dist)) ;;; (setq tp (polar mp (- ang1 (deg2rad 90.0)) dist)) ;;; ) (setq mp (mapcar '/ (mapcar '+ al ar) '(2. 2. 2.) ) ) ; uALR = unit vector from al to ar (setq uALR (uvec (mapcar '- ar al))) (setq s (dot uALR (mapcar '- txp al))) ; txpp = projection of txp onto the line (setq txpp (mapcar '+ al (mapcar '* uALR (list s s s))) ) (setq uvt (uvec (mapcar '- txp txpp))) (setq tp (mapcar '+ mp (mapcar '* uvt (list dist dist dist)))) (entmod (subst (cons 10 tp) (assoc 10 (entget ent)) (entget ent)) ) (entmod (subst (cons 11 tp) (assoc 11 (entget ent)) (entget ent)) ) ) (princ) )
    3 points
  4. A few sites I trust besides Cadtutor: http://www.lee-mac.com/programs.html https://www.afralisp.net/ https://jtbworld.com/autolisp-visual-lisp https://autolisp-exchange.com/ https://gilecad.azurewebsites.net/Lisp.aspx Got to be responsible though put them in a folder in both the Support File Search Path and Trusted Folders. I also don't download any compiled code, lisp and dcl only.
    3 points
  5. Another one commonly used to pull point lists .. modified for 100 code: (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 100 (car x))) elist))
    3 points
  6. But here is a great place to learn a bit more about it
    3 points
  7. You understand that (setq myblockcolour 10) is red and want to change it to Byblock? lisp typically only use numbers for colors. You can see all the different colors #'s use this. (acad_colordlg 1) Their are also 7 colors you can call by their name like red, yellow, green, cyan, blue, magenta, white @BIGAL is giving you the answer. (setq myblockcolour 0) ;= Byblock (setq myblockcolour 256) ;= Bylayer (setq myblockcolour (acad_colordlg 1)) ;user can pick the color each time the lisp is ran
    3 points
  8. 3 points
  9. It is the same lisp, can you keep 1 thread about it? I think you got to restructure the lisp, break it downs to some levels, each function do some specific thing then it will easier to debug (defun get_objects_in_viewport (viewport /) ... the hard code goes here ... ss ;return the selectionset ) ;------------------------------------------ (defun change_dimension_accordingly (viewport /) (setq ss (get_objects_in_viewport viewport)) ... do the changing code here ... ) ;------------------------------------------ (defun C:maincommand (/ *error*) (defun *error* (msg) (princ msg) ;or do something here ... ) (setq allviewports (ssget ...)) (... loop through allviewports ... >>> (change_dimension_accordingly viewport) ) (princ) )
    2 points
  10. You could always try a while loop and a counter - I tend to go that way by default but that's just me. Added some 'princ' to tell you how it is going on as an example below.. overkill but sometimes seeing it all written out helps (princ "\nMy List: ") (princ list) ;;Gives you the full list so you can see it (setq acount 0) (while (< acount (length list)) (setq pt (nth acount list)) (princ "\n - count: ") (princ acount) ; Position in list (princ " : pt: " ; (princ pt) ; point (command "copy" pt "" basept despt) (princ "COPY OK") ; Copied OK (setq acount (+ acount 1)) ) ; end while (princ "All Copied") If it struggles at that post what the princ statements say... should be a clue in them
    2 points
  11. WoW!!!! thanks @mhupp and @Emmanuel Delay; both lisp works well !!!! @Emmanuel Delay, actually I've want rtab_x and rtab_y It is better for " on site" to be up/down left/right @mhupp You did great Job. It is also numbering rebars. I will try to add to ask user to get firstly number of rebar; like for expample "4" and then it will number it like 4.1, 4.2, 4.3 etc. Also need to add round of the lenght. Guys! You did work for me! actually I thougt I will do this myself just with Your help, but the job is done!!! Thank You so much!
    2 points
  12. Hi, This line ask user to select a viewport on screen. If you already have the viewport (iterate through your viewport selection set), you got to skip this step, and put your viewport directly in (if (and (= (getvar "cmdactive") 0) (/= (setq ss (ssget ":E:S" '((0 . "VIEWPORT")))) nil) ) Replace ;replace this: (setq ent (ssname ss 0)) ;with this: (setq ent yourviewporthere) Also the vpsel function pass the result to the grip selection, then nullify the result at the end (setq ss nil ss1 nil) While you want to get the result, so, you got to comment out that line, and take the ss1 result out of the function, merge it to your rrr selection
    2 points
  13. That's the problem when you run an older version of AutoCAD under a newer version of Windows. Everything initially works as planned then one day Microsoft sends out an update which is accepted without question and everything goes to hell. Have you looked at Longbow Converter? https://www.longbowsoftware.com/Converter.php
    2 points
  14. I also don't download any compiled code, lisp and dcl only.
    2 points
  15. Thank you for your kind words, Dadgad. However, in the words of the Civil War General Tecumseh Sherman, "I will not accept if nominated (re: Project Proof Reader position) and will not serve if elected."
    2 points
  16. Just a note to say thanks for maintaining this site. It's a pleasure to come here, read a question, type out a response and see it instantly appear to help the other user(s). Image attachments via drag+drop work flawlessly too. It is noticed and appreciated. Cheers!
    2 points
  17. why do not use xdata? https://www.afralisp.net/autolisp/tutorials/extended-entity-data-part-1.php
    2 points
  18. @mhupp FWIW ;; This (foreach blk (mapcar 'cadr (ssnamex ss)) (setq ed (entget blk) ed (subst (cons 8 (car ent)) (assoc 8 ed) ed) ed (subst (cons 41 (cadr ent)) (assoc 41 ed) ed) ed (subst (cons 42 (caddr ent)) (assoc 42 ed) ed) ed (subst (cons 43 1) (assoc 43 ed) ed) ) (entmod ed) ) ;; Can be written like this (foreach blk (mapcar 'cadr (ssnamex ss)) (entmod (append (entget blk) (list (cons 8 (car ent)) (cons 41 (cadr ent)) (cons 42 (caddr ent)) (cons 43 1)) ) ) ) ;; Or this too :) (foreach blk (mapcar 'cadr (ssnamex ss)) (entmod (append (entget blk) (mapcar 'cons '(8 41 42 43) (list (car ent) (cadr ent) (caddr ent) 1))) ) ) Assuming I didn't fat finger something
    2 points
  19. This has been asked many times over ... HERE is a function you can use. Do you know how to get points from a polyline?
    2 points
  20. Hi Here is a simple function, works for any nesting level (defun replace_sublist (lst old new) (mapcar (function (lambda (x) (cond ((equal x old) new) ((atom x) x) (T (replace_sublist x old new)) ) ) ) lst ) ) And some tests _$ (setq number2 (list 1 (list 2 (list 3 (list 4 5))) 7)) (1 (2 (3 (4 5))) 7) _$ (replace_sublist number2 5 (list 5 6)) (1 (2 (3 (4 (5 6)))) 7) _$ (replace_sublist number2 7 (list 7 8)) (1 (2 (3 (4 5))) (7 8)) _$ (replace_sublist number2 (list 4 5) 4) (1 (2 (3 4)) 7) _$
    2 points
  21. I don't know exactly how to explain it.. either I will look brilliant by saying what I think or everyone will say "no it's not that at all you fool". Anyway I think it is all to do with moving along the nested lists until there is no more lists but it can't then 'un-nest' back up the levels.. I think... So what I thought is you might need to explicitly loop through each item in the list and analyse that as you loop through and repeat as you come to a new nested list, when that nested list is finished the loop moves onto the next item in its parent list.. or something like that Anyway, you could try this: (defun testlist (mylist mysearchterm myreplace / Newlist) (defun checklist ( alist mysearchterm myreplace / acount mylist) (defun LM:SubstNth ( a n l ) (if l (if (zerop n) (cons a (cdr l)) (cons (car l) (LM:SubstNth a (1- n) (cdr l))) ) ) ) (setq acount 0) (while (< acount (length alist)) (if (= (TYPE (nth acount alist)) 'LIST) (setq mylist (LM:SubstNth (checklist (nth acount alist) mysearchterm myreplace ) acount alist)) (progn ;;if not list (if ( = (nth acount alist) mysearchterm) (setq mylist (LM:SubstNth myreplace acount alist)) ) ; end if ) ; end progn ) ; end if (setq acount (+ acount 1)) ) ; end while mylist ) (princ "My Old List: ") (princ mylist) (princ ". Subs: ") (princ mysearchterm) (princ ". New Item: ") (princ myreplace) (setq Newlist (checklist mylist mysearchterm myreplace)) (princ " : My New List: ") (princ Newlist) (princ) )
    2 points
  22. how about this cad object to dcl code converter https://www.theswamp.org/index.php?topic=20878.msg255063 use png or bmp to dxf converter then edit to looks better then use this
    2 points
  23. (defun C:SSAEXT4 (/ output Mainoutput SS ent P1 P2 P3 P4 P5 P6 P7 P8 P9 P10) ;best to name variables (vl-load-com) (if (setq SS (ssget '((0 . "LWPOLYLINE,LINE,POINT")))) (foreach obj (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (setq ent (vlax-ename->vla-object obj) P1 (vla-get-Objectname ent) ) (cond ((eq "AcDbPoint" P1) (setq P2 (vlax-get ent 'layer) P3 (itoa(vlax-get ent 'color)) P10 (rtos(caddr (vlax-get ent 'Coordinates))2) output (list P1 P2 P3 "-" "-" "-" "-" "-" "-" P10) ) ;setq ) ;eq ((eq "AcDbLine" P1) (setq P2 (vlax-get ent 'layer) P3 (itoa(vlax-get ent 'color)) P4 (rtos(vlax-get ent 'length)2) P5 (vlax-get ent 'linetype) P6 (vlax-get ent 'Lineweight) P7 (rtos(vlax-get ent 'thickness)2) P8 "0" P9 "VOID" P10 (rtos(caddr (vlax-get ent 'Startpoint))2) ;assumes flat line ) ; setq (cond ((= P6 -1) (setq P6 "ByLayer")) ((= P6 -2) (setq P6 "ByBlock")) ((= P6 -3) (setq P6 "Default")) ((< P6 10) (setq P6 (strcat "0.0" (vl-princ-to-string P6) "mm") )) ((< P6 100) (setq P6 (strcat "0." (vl-princ-to-string P6) "mm") )) ((>= P6 100) (setq P6 (strcat (substr (vl-princ-to-string P6) 1 1) "." (substr (vl-princ-to-string P6) 2 2) "mm") )) ) (setq output (list P1 P2 P3 P4 P5 P6 P7 P8 P9 P10)) ) ; eq ((eq "AcDbPolyline" P1) (setq P2 (vlax-get ent 'layer) P3 (itoa(vlax-get ent 'color)) P4 (rtos(vlax-get ent 'length)2) P5 (vlax-get ent 'linetype) P6 (vlax-get ent 'Lineweight) P7 (rtos(vlax-get ent 'thickness)2) P8 (rtos(/ (vlax-get ent 'area) 1000000)2) P9 (vlax-get ent 'closed) P10 (rtos(vlax-get ent 'Elevation)2) ) ;setq (cond ((= P9 -1) (setq P9 "Closed")) ((= P9 0) (setq P9 "Opened")) ) (cond ((= P6 -1) (setq P6 "ByLayer")) ((= P6 -2) (setq P6 "ByBlock")) ((= P6 -3) (setq P6 "Default")) ((< P6 10) (setq P6 (strcat "0.0" (vl-princ-to-string P6) "mm") )) ((< P6 100) (setq P6 (strcat "0." (vl-princ-to-string P6) "mm") )) ((>= P6 100) (setq P6 (strcat (substr (vl-princ-to-string P6) 1 1) "." (substr (vl-princ-to-string P6) 2 2) "mm") )) ) (setq output (list P1 P2 P3 P4 P5 P6 P7 P8 P9 P10)) ) ; eq ) ; cond (setq Mainoutput (cons output Mainoutput)) ) (prompt "/nNothing Selected") ) (if ss (progn (setq file (open (getfiled "Name output file" (getvar "DWGPREFIX") "CSV" 1) "w")) (write-line "Name,Layer,Color,Length-mm,Linetype,Lineweight,Thickness,Area-sqm,Closed,DeltaZ" file) ;;writes the headers to the .CSV (foreach row Mainoutput (write-line (lst2str "," row) file) ) (close file) ) ) (princ) ) ;;----------------------------------------------------------------------------;; ;; Function to convert list to string ;; (lst2str "," lst) (defun lst2str (dlim lst / rtn) (setq rtn (car lst) lst (cdr lst)) (repeat (length lst) (setq rtn (strcat rtn dlim (car lst)) lst (cdr lst) ) ) rtn ) I just add small Duct Tapes fix to mhupp's code. for polyline "opened" and "closed" for line & polyline "lineweight" - ByLayer ByBlock Default and numbers. I can't solve lineweight decimal point problem, I try to (rtos (/ P6 100) 2 2) it deletes under decimal points values. MEASUREMENT system variable control that? I don't know. so duct taping to that like this ((< P6 10) (setq P6 (strcat "0.0" (vl-princ-to-string P6) "mm") )) ((< P6 100) (setq P6 (strcat "0." (vl-princ-to-string P6) "mm") )) ((>= P6 100) (setq P6 (strcat (substr (vl-princ-to-string P6) 1 1) "." (substr (vl-princ-to-string P6) 2 2) "mm") )) it works anyway
    2 points
  24. Just an extra to what Mhupp provided ignoring the number v's string you must check more carefully for typo's ("BLOCK2" "LAYER2" "500" ""500 "1") 2 mistakes a double "" and a missing "
    2 points
  25. Updated code above: ("Enter name of file to overlay" "InitialDirectory")
    2 points
  26. Yup .. just tested here. I'll see if I can find that key as well.
    2 points
  27. This will return the entity list from the second one on: (member (assoc 100 (cdr (member (assoc 100 ent) ent))) ent) You could save and repeat until none remain.
    2 points
  28. @CADTutor your forums wouldn't do people like that. You can have things selected before you run this command. So i made a little lisp that selects all blocks in model space then runs this command. ;;----------------------------------------------------------------------------;; ;; CHANGES ALL BLOCK COLOR (defun C:ALL_SETBLOCKCOLOR (/ SS) (if (setq SS (ssget "_X" '((0 . "INSERT") (410 . "Model")))) (progn (sssetfirst nil SS) (C:SETBLOCKCOLOR) ) (prompt "\nNo Blocks in Model Space") ) (princ) ) This replaces the entity selection (one at a time) with and ssget so you can select multiple at a time. With the ssget it filters your selection down to blocks. So you don't have to be to precise with the selection window. just make sure only to select the blocks you want to change. (defun C:SETBLOCKCOLOR (/ _blkcolour c e l) (defun _blkcolour (n c / a e x) (if (and (setq e (tblobjname "block" n)) (not (member n l))) (while (setq e (entnext e)) (entmod (append (vl-remove-if '(lambda (x) (member (car x) '(62 420 430))) (setq x (entget e)) ) c ) ) (if (= "INSERT" (cdr (assoc 0 x))) (_blkcolour (cdr (assoc 2 x)) c) ) ) (setq l (cons n l)) ) nil ) (if (and (setq c (acad_truecolordlg 1)) (setq SS (ssget ":L" '((0 . "INSERT"))))) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (cond ((= 7 (getvar 'errno)) (princ "\nMissed, try again.") ) ((= 'ename (type e)) (_blkcolour (cdr (assoc 2 (entget e))) c) ) ) ) ) (command "_.regen") (princ) )
    2 points
  29. (defun c:scc (/ ss pt1 pt2 dist size mat) (setq ss (ssget)) (setq pt1 (getpoint "Point 1 :")) (setq pt2 (getpoint "Point 2 :" pt1)) (setq dist (distance pt1 pt2)) ;; Where is "mat' set ?? (cond ((eq "S1" mat) 200) ((eq "S2" mat) 400) (t nil) ) (progn (initget "S1 S2") (setq size (getdist "\nSize scale: [S1/S2]")) (command "scale" ss "" pt1 "R" dist size) ) ) ; <- you were missing this ?? (defun c:scc_fix (/ dist pt1 pt2 size ss) (if ;; Check that selection AND pt1 AND pt2 are valid (and (setq ss (ssget)) (setq pt1 (getpoint "Point 1 :")) (setq pt2 (getpoint "Point 2 :" pt1))) (progn (setq dist (distance pt1 pt2)) (initget "S1 S2") (setq size (getdist "\nSize scale: [S1/S2]")) (command "scale" ss "" pt1 "R" dist (if (= "S1" size) 200 400 ) ) ) ) (princ) )
    2 points
  30. You could try this: "attred" and will set the block objects to colour "10" (red), however it won't change any nested blocks definitions, just change their colour (so if that nested block is drawn using Green lines it will show as green, if it is drawn using "ByBlock" coloured lines it will show as red (or whatever colour you set this to be) Please note that I copied and pasted a lot of this but I didn't note where I took the original parts from, if the originator reads this, thanks I use this all the time, but let me know so I can credit you accordingly. (defun c:attred (/ myblocklayer myblockcolour myblocklineweight myblocklinetype) (setq myblocklayer "0") (setq myblockcolour 10) (setq myblocklineweight aclnwtbyblock) (setq myblocklinetype "byblock") (mynorm myblocklayer myblockcolour myblocklineweight myblocklinetype) (princ) ) (defun mynorm (myblocklayer myblockcolour myblocklineweight myblocklinetype / *error* adoc lst_layer func_restore-layers) (defun *error* (msg) (func_restore-layers) (vla-endundomark adoc) (princ msg) (princ) ) ;_ end of defun (defun func_restore-layers () (foreach item lst_layer (vla-put-lock (car item) (cdr (assoc "lock" (cdr item)))) (vl-catch-all-apply '(lambda () (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))) ) ;_ end of vla-put-freeze ) ;_ end of lambda ) ;_ end of vl-catch-all-apply ) ;_ end of foreach ) ;_ end of defun (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))) ) ;_ end of vla-startundomark (if (and (not (vl-catch-all-error-p (setq selset (vl-catch-all-apply (function (lambda () (ssget '((0 . "INSERT"))) ) ;_ end of lambda ) ;_ end of function ) ;_ end of vl-catch-all-apply ) ;_ end of setq ) ;_ end of vl-catch-all-error-p ) ;_ end of not selset ) ;_ end of and (progn (vlax-for item (vla-get-layers adoc) (setq lst_layer (cons (list item (cons "lock" (vla-get-lock item)) (cons "freeze" (vla-get-freeze item)) ) ;_ end of list lst_layer ) ;_ end of cons ) ;_ end of setq (vla-put-lock item :vlax-false) (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)) ) ;_ end of vl-catch-all-apply ) ;_ end of vlax-for (foreach blk_def (mapcar (function (lambda (x) (vla-item (vla-get-blocks adoc) x) ) ;_ end of lambda ) ;_ end of function ((lambda (/ res) (foreach item (mapcar (function (lambda (x) (vla-get-name (vlax-ename->vla-object x) ) ;_ end of vla-get-name ) ;_ end of lambda ) ;_ end of function ((lambda (/ tab item) (repeat (setq tab nil item (sslength selset) ) ;_ end setq (setq tab (cons (ssname selset (setq item (1- item)) ) ;_ end of ssname tab ) ;_ end of cons ) ;_ end of setq ) ;_ end of repeat tab ) ;_ end of lambda ) ) ;_ end of mapcar (if (not (member item res)) (setq res (cons item res)) ) ;_ end of if ) ;_ end of foreach (reverse res) ) ;_ end of lambda ) ) ;_ end of mapcar (vlax-for ent blk_def ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;Sets the block attributes ;;add in here other attributes to change (vla-put-layer ent myblocklayer) (vla-put-color ent myblockcolour) (vla-put-lineweight ent myblocklineweight) ;; (vla-put-linetype ent myblocklinetype) ;;end of setting up block attributes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ) ;_ end of vlax-for ) ;_ end of foreach (func_restore-layers) (vla-regen adoc acallviewports) ) ;_ end of progn ) ;_ end of if (vla-endundomark adoc) (princ) ) ;_ end of defun
    2 points
  31. SEE (defun c:QQQnewleader ( / C EXYZ NEWLEADER PTEN PTS_SS SS_LEN ) (setq pts_ss (ssget (list (cons 0 "*TEXT")))) (setq ss_len (sslength pts_ss)) (setq c 0) (while (< c ss_len) (progn (setq pten (ssname pts_ss c)) (setq exyz (cdr (ASSOC 10 (ENTGET pten)))) (command "._MLEADER" exyz (list (+ 0.5 (car exyz)) (+ 0.2 (cadr exyz)) (caddr exyz)) "") (setq newleader (vlax-ename->vla-object (entlast))) (vla-put-textstring newleader (cdr (ASSOC 1 (ENTGET pten)))) (setq c (+ c 1)) ) ) (princ) )
    2 points
  32. I can see how that might be useful. Unfortunately, the editor is a rather complex part of the platform. There are various improvements I'd *like* to make, syntax highlighting for AutoLISP springs to mind, but so far I've found it difficult to work with this part of the forum. I haven't given up on any of this, but I can't promise a solution in the short term.
    2 points
  33. Hi @rkmcswain and all who have commented - thanks for your kind words. It has been a pleasure to keep this forum in good order over so many years (the CADTutor site is 25 years old this year!). Naturally, a forum isn't anything without its members, so I thank you all, in return, for being such a great community who continue to post brilliant content and .give your time freely to help others. Long may it continue!
    2 points
  34. I wasn't aware there were any others. I must get out more!
    2 points
  35. Also the best users, mods and admin!
    2 points
  36. You're welcome liuhaixin!
    2 points
  37. Its a pity Autodesk killed Lisp Enabler for LT. As you say Steven a good VBA programmer may be able to use excel as front end creating scripts or copy paste a column.
    1 point
  38. Nice.... The reason I asked was that I haven't seen an effective way to have an open drawing interrogate or modify another open drawing. You can use a script on any closed drawings (there are some examples out there), some like scriptwriter, Lee Macs. or Jeff Saunters will do it all in the background and you can write a script to open, operate on and close a drawing - and here you can use any LISP commands you want, but I have struggled to find a way to do that on an open drawing by LISP - the problem being that LISPS run on the drawing that started them off, and once you move from that the LISP won't keep running in the next drawing. Depending what you want to do once you have the title block info I would be tempted to do it all on closed drawings, select the ones you want and do it all with a script (scriptwriter, Lee Mac, Jeff Saunter, or mine (below) should all be able to do that)
    1 point
  39. I Usually just use ssget to get ent name of stuff. (if (setq SS (ssget "X" '((0 . "INSERT") (2 . "SAL-TEKENBLAD_TITELBLOK")))) (foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) This will get you a selection set of all SAL-TEKENBLAD_TITELBLOK in the drawing. If you want to get a particular titleblock you can further limit it down to a specific layout. by adding (410 . "Tab Name") (setq SS (ssget "X" '((0 . "INSERT") (2 . "SAL-TEKENBLAD_TITELBLOK") (410 . "Sheet 3"))))
    1 point
  40. The home user version of Longbow Converter is currently priced at $79.99 US. That would be my recommendation.
    1 point
  41. This will explode all block in the drawing in model or paper space that is not on layer A3_TT with a simple ~. (defun C:blkExp (/ SS) (if (setq SS (ssget "_X" '((0 . "INSERT") (8 . "~A3_TT")))) ;the ~ = all layers not A3_TT (foreach ent (mapcar 'cadr (ssnamex SS)) (vla-explode (vlax-ename->vla-object ent)) ;works on blocks on other tabs ) ) )
    1 point
  42. (setq List1 '(a b c) list2 '((a n1) (c n3) (b n2)) list3 '((n1 m1) (n1 m2) (n1 m3) (n2 m4) (n2 m5) (n3 m6)) list4 '((m1 p1) (m2 p2) (m3 p3) (m4 p4) (m5 p5) (m6 p6)) ) (mapcar '(lambda (x / y z) (cond ((setq y (cadr (assoc (car x) (mapcar 'reverse list3)))) (cond ((setq z (cadr (assoc y (mapcar 'reverse list2)))) (list z (cadr x)) ) ((list y (cadr x))) ) ) (x) ) ) list4 ) -->((A P1) (A P2) (A P3) (B P4) (B P5) (C P6))
    1 point
  43. That's correct. I'm sorry to about that. I misunderstood that the coordinates obtained by (assoc 10) in the text, are "points". As you said, when I (princ), there was a 10 value in the front. ((10 xxxx yyyy zzzz)(10 xxxx yyyy zzzz)(10 xxxx yyyy zzzz)) So, I modified the code as follows, and it succeeded. thank you very much (defun c:DFT( / *error* seltxt selcount selnum old_osmode ob count a5 bas name xxlist enti1 enti2 dxy x xx y yy xy finded num pcolor seldxy selx selxx sely selyy selxy ) (setvar "cmdecho" 0) (command "ucs" "w") (command "_undo" "_be") (defun *error*(e) (command "_undo" "_e") (princ) ) (setq old_osmode (getvar "osmode")) (setvar "osmode" 0) (setq scolor 1) ;set line's default color (setq seltxt (ssget '((0 . "text,mtext")))) (setq selcount (sslength seltxt)) (setq selnum 0) (setq finded 0) (setq ob (ssget "x" '((0 . "text,mtext")))) (setq count (sslength ob)) (repeat selcount (setq a5 (cdr (assoc 1 (entget (ssname seltxt selnum))))) (setq seldxy (assoc 10 (entget (ssname seltxt selnum)))) (setq selx (nth 1 seldxy)) (setq sely (nth 2 seldxy)) (setq seldxypoint (list selx sely)) (setq num 0) (repeat count (setq name (ssname ob num)) (setq xxlist (entget name)) (progn (setq enti1 (cdr (assoc -1 xxlist))) (setq text2 (cdr (assoc 1 xxlist))) (setq dxy (assoc 10 xxlist)) (setq x (nth 1 dxy)) (setq y (nth 2 dxy)) (setq dxypoint (list x y)) (if (wcmatch (strcase (LM:UnFormat text2 nil))(strcat "*" (strcase (LM:UnFormat a5 nil)) "*")) (if (/= seldxy dxy) (progn (setq pointlist (list dxypoint seldxypoint)) (LWPoly pointlist 0) (vlax-put-property (vlax-ename->vla-object (entlast)) "Color" scolor) (setq finded (+ finded 1)) );progn );if );if );progn (setq num (+ num 1)) );repeat (setq selnum (+ selnum 1)) (setq scolor (+ scolor 1)) );repeat (prompt (strcat "\n The number of duplicate texts = " (rtos finded) " ea")) (if ( = finded 0 ) (alert "There's no duplicated texts.")) (command "_undo" "_e") (setvar "osmode" old_osmode) (princ) (command "ucs" "p") (princ) );end_defun ;;-------------------=={ UnFormat String }==------------------;; ;; ;; ;; Returns a string with all MText formatting codes removed. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright ⓒ 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; str - String to Process ;; ;; mtx - MText Flag (T if string is for use in MText) ;; ;;------------------------------------------------------------;; ;; Returns: String with formatting codes removed ;; ;;------------------------------------------------------------;; (defun LM:UnFormat ( str mtx / _replace rx ) (defun _replace ( new old str ) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new) ) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda ( ) (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '( ("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_replace "\\" "\032" str) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) (vl-load-com) (defun LWPoly (lst cls) ; LM's entmake functions (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls) ) (mapcar (function (lambda (p) (cons 10 p))) lst) ) ) )
    1 point
  44. So when you were trying to work out what was going wrong, what did you find - it will save us all a little time if you don't end with "this doesn't work" but if you can add details such as "this doesn't work and think this is the problem" For example, does it call the LWPoly routine OK?.. working out where it all goes wrong. If it does then just put a temporary line in there "(princ lst)" to check what values are being passed to it, suspect that will give you the answer.....
    1 point
  45. If you are going to be doing this regularly, or have a lot to do, then I suggest that you purchase a conversion utility. I always used to use PDF Fly, it's not free but it always did very good vector PDF to DWG/DXF conversion with very little clean up needed following the conversion. It would also import raster PDFs as images into Autocad. https://visual-integrity.com/products/pdf-fly-pdf-conversion-suite/ There is a service where you can get one free conversion per week to see what their conversion products can do for you: https://convertpdf.today/
    1 point
  46. If you only want to add another piece of data, you could use ATTDEF to define a new attribute.
    1 point
  47. take a look this wireruns.lsp need theswamp id http://www.theswamp.org/index.php?topic=45092.msg503931#msg503931 ====================================== if you have coordinates of destinations 1. spread destinations by texts to cad by excel or manually 2. then draw some main line (main tray) 3. and draw minimum shortest line between text and main lines, by lisp (by ronjonp) (defun c:MIN (/ _dxf _sl a b c e p s x) ;; RJP ≫ 2019-01-10 (defun _sl (s) (cond ((= 'pickset (type s)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))))) (defun _dxf (c e) (cdr (assoc c (entget e)))) (cond ((setq s (_sl (ssget))) (foreach x s (if (wcmatch (_dxf 0 x) "TEXT") ;edited line (setq b (cons (_dxf 10 x) b)) (and (= 'real (type (vl-catch-all-apply 'vlax-curve-getendparam (list x)))) (setq a (cons x a)) ) ) ) (and a b (foreach p b (setq c (car (vl-sort (mapcar '(lambda (x) (list (setq c (vlax-curve-getclosestpointto x p)) (distance p c) (_dxf 8 x)) ) a ) '(lambda (r j) (< (cadr r) (cadr j))) ) ) ) (setq e (entmakex (list '(0 . "LINE") (cons 10 p) (cons 11 (car c)) (cons 8 (caddr c))))) ;; This line below creates the right example comment out to get left ;; (setq a (cons e a)) ) ) ) ) (princ) ) 4. use mpedit command to make polyline 5. breaking all crossing polylines https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/break-all-polylines/m-p/2251689/highlight/true#M260485 add ucs w, ucs p line if you use this in custom ucs drawing 6. use wireruns lisp then I edit this "to points" inserts(block) -> text and If it is an alternative CAD other than AutoCAD, some modifications are required. 7. use fmp lisp (filletmultiplepolylines.lsp) https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/fillet-multiple-polyline-all-at-once-by-lisp/m-p/10151411/highlight/true#M412320
    1 point
  48. Maybe this, not tested save list as ((y X)(y x).... ; sorts on 1st two items (vl-sort lst '(lambda (a b) (cond ((< (car a) (car b))) ((= (car a) (car b)) (< (cadr a) (cadr b))) ) ) )
    1 point
  49. In response to your message we have reviewed the project instructions on your student portal and it appears that there is one section that does not display correctly. While a correction is being made I have attached a file which contains the "missing bullet" items showing the distances and bearings required for the last two subdivision boundaries. Please feel free to contact me if you have further questions and keep in mind you can always attach your actual .dwg drawing file in a message for review to make sure you are on the right track. Sincerely, Jon D. Instructor 4 main subdivision boundaries.pdf
    1 point
×
×
  • Create New...