Jump to content

All Activity

This stream auto-updates

  1. Past hour
  2. I'll try, but I'm not sure of my knowledge...
  3. You can paste the 'ordena' function below the rest of the code.
  4. Try to do it with the explanations I've given you. That will help you understand the changes somewhat. If there's anything in the explanation you don't understand, don't hesitate to ask.
  5. Thanks @GLAVCVS how do I add this to the code correctly?
  6. You can call this function after creating the two ssets with '(ordena col1 col2)'. Then you should undo the 5 lines of code under ';; Defining the step...' And in 'repeat', replace '(sslength col1)' with '(length l1)' Additionally, you would also need to replace '(ssname col1 i)' with '(cadr (nth i l1))' and '(ssname col2 i)' with '(cadr (nth i l2))' Finally, if you want p3 to be exactly the same Y coordinate as the text in column 2, you can replace your current code '(setq p3 (+ (cadr basept)...)' with '(setq p3 (list (car basept) (car (nth i l2)) 0.0))' With all this, your code should work.
  7. mohammadreza

    install lisps, DCLs, Cuix

    I'm happy to hear about this approach. Could you please share it if you can?
  8. Today
  9. More compact (defun ordena (cj1 cj2 / e l n m c) (setq l1 nil l2 nil) (foreach cj (list cj1 cj2) (setq l (cons (vl-sort (while (setq e (ssname cj (setq n (if n (1+ n) 0)))) (setq c (cons (list (caddr (assoc 10 (entget e))) e) c)) ) '(lambda (a b) (> (car a) (car b))) ) l ) c nil n nil ) ) (setq l1 (car l) l2 (cadr l)) )
  10. If the order will always be the same, and the number of elements will also be the same (because the code ensures this), then all you need to do is convert the two sets into two lists ordered by their Y coordinates, from highest to lowest. This could be done like this: (defun ordena (cj1 cj2 / e l n m) (setq l1 nil l2 nil) (setq l1 (vl-sort (while (setq e (ssname cj1 (setq n (if n (1+ n) 0)))) (setq l (cons (list (caddr (assoc 10 (entget e))) e) l)) ) '(lambda (a b) (> (car a) (car b))) ) l nil ) (setq l2 (vl-sort (while (setq e (ssname cj2 (setq m (if m (1+ m) 0)))) (setq l (cons (list (caddr (assoc 10 (entget e))) e) l)) ) '(lambda (a b) (> (car a) (car b))) ) ) ) In these lists each element is another list of 2 elements, where the first is the Z coordinate of the text and the second, its entity name.
  11. @Steven P @BIGAL Thanks for the clarifications. There are just 2 columns with separate text or mtext with numeric values, there can be 2-30 rows in columns... I select the first column - pcm, then the 2nd column - pcm and specify the insertion point of the 3rd column with the result. 1st row of 1st column minus 1st row of 2nd column = 1st row of 3rd column, etc. The above code copes with the task (30 lines or more), but sometimes it crashes and that's why I have to check the result for correctness, so now I can't trust the received values... The interval between the rows does not always match the interval between the rows of the 1st and 2nd columns...
  12. BIGAL

    Bevel (slope) Label

    Ok found out a bit more if you have shallow angles then whilst it still works. from a drafting point of view is not desirable, as an example I get 12" and 8' 2" so line work draws over original line, will fix. I have updated the code try this. ; https://www.cadtutor.net/forum/topic/97227-bevel-slope-label/ ; draw bevel label ; By AlanH April 2025 (defun c:bevel ( / h0180 ah090 ah2700 ang d1 d2 dist dofracs dofracs endpt ht oldangdir oldcol oldsnap pt2 pt2a startpt tanang) ; thanks to lee-mac for this defun (defun csv->lst (str ans / pos ) (if (setq pos (vl-string-position ans str)) (cons (substr str 1 pos) (csv->lst (substr str (+ pos 2)) ans)) (list str) ) ) (defun dofracs ( / a ht1 ht2 ht3 ht4 frac) (setq frac (- ht (fix ht))) (setq frac (atof(rtos frac 2 3))) (if (> frac 0.0) (progn (setq txt (rtos ht 4 4)) (setq a (csv->lst txt 32)) (setq ht1 (car a)) (setq ht2 (csv->lst (cadr a) 47)) (setq ht3 (car ht2)) (setq ht4 (cadr ht2)) (setq httxt (strcat ht1 "{\\H0.70x;\\S" ht3 "#" ht4 ";}")) ) (setq httxt (rtos ht 2 0)) ) (princ) ) (DEFUN AH090 ( / angt ht mp pt3 pt4) (setq pt3 (polar pt2a (* pi (- 0.5)) dist)) (setq pt4 (polar pt3 pi 4.)) (command "line" startpt pt2 "") (command "line" pt2a pt3 "") (command "line" pt3 pt4 "") (setq ht (* 3. dist)) (setq angt (/ (* ang 180.0) pi)) (setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5))) (setq mp (mapcar '+ mp '(0.25 0.0 0.0))) (dofracs) (command "mtext" mp "J" "ML" mp httxt "") (setq mp (polar pt3 pi 2.0)) (setq mp (mapcar '+ mp '(0.0 -0.25 0.0))) (command "text" "J" "TC" mp 1 0.0 "12\"") (setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5))) (setq mp (mapcar '+ mp '(0.0 0.25 0.0))) (setvar 'angdir 0) (command "text" "J" "BC" mp 1 angt (strcat (rtos angt 2 2) "%%d")) (princ) ) (DEFUN AH90180 ( / angt ht mp pt3 pt4) (setq pt3 (polar pt2a (* pi 1.5) dist)) (setq pt4 (polar pt3 0.0 4.)) (command "line" startpt pt2 "") (command "line" pt2a pt3 "") (command "line" pt3 pt4 "") (setq ht (* 3. dist)) (setq angt (/ (* (- pi ang) 180.0) pi)) (dofracs) (setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5))) (setq mp (mapcar '+ mp '(-0.25 0.0 0.0))) (command "mtext" mp "J" "MR" mp httxt "") (setq mp (polar pt3 0.0 2.0)) (setq mp (mapcar '+ mp '(0.0 -0.25 0.0))) (command "text" "J" "TC" mp 1 0.0 "12\"") (setvar 'angdir 1) (setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5))) (command "text" "J" "BC" mp 1 angt (strcat (rtos angt 2 2) "%%d")) (princ) ) (DEFUN AH180270 ( / angt ht mp pt3 pt4 ) (setq pt3 (polar pt2a (* pi 0.5) dist)) (setq pt4 (polar pt3 0.0 4.)) (command "line" startpt pt2 "") (command "line" pt2a pt3 "") (command "line" pt3 pt4 "") (setq ht (* 3. dist)) (setq angt (/ (* (- ang pi) 180.0) pi)) (dofracs) (setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5))) (setq mp (mapcar '+ mp '(-0.25 0.0 0.0))) (command "mtext" mp "J" "MR" mp httxt "") (setq mp (polar pt3 0.0 2.0)) (setq mp (mapcar '+ mp '(0.0 0.25 0.0 ))) (command "text" "J" "BC" mp 1 0.0 "12\"") (setvar 'angdir 0) (setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5))) (setq mp (mapcar '+ mp '(0.0 -0.25 0.0 ))) (command "text" "J" "TC" mp 1 angt (strcat (rtos angt 2 2) "%%d")) (princ) ) (DEFUN AH2700 ( / angt ht mp pt3 pt4 ) (setq pt3 (polar pt2a (* pi 0.5) dist)) (setq pt4 (polar pt3 pi 4.)) (command "line" startpt pt2 "") (command "line" pt2a pt3 "") (command "line" pt3 pt4 "") (setq ht (* 3. dist)) (setq angt (/ (* (- (* 2.0 pi) ang) 180.0) pi)) (dofracs) (setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5))) (setq mp (mapcar '+ mp '(0.25 0.0 0.0 ))) (command "mtext" mp "J" "ML" mp httxt "") (setq mp (polar pt3 pi 2.0)) (setq mp (mapcar '+ mp '(0.0 0.25 0.0 ))) (command "text" "J" "BC" mp 1 0.0 "12\"") (setvar 'angdir 1) (setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5))) (setq mp (polar mp (- ang (/ pi 2.0)) 0.25 )) (command "text" "J" "TC" mp 1 angt (strcat (rtos angt 2 2) "%%d")) (princ) ) ;; starts here (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq oldcol (getvar 'cecolor)) (setvar 'cecolor "1") (setq oldangdir (getvar 'angdir)) (setvar 'textstyle "standard") (setvar 'textsize 1) (setq pi90 (* 0.5 pi) pi180 (* 1.5 pi)) (if (= (tblsearch "layer" "Beveldim") nil) (command "-layer" "M" "Beveldim" "C" "1" "" "") (setvar 'clayer "Beveldim") ) (setq ent (entsel "\npick a line near end ")) (setq obj (vlax-ename->vla-object (car ent))) (setq startpt (vlax-curve-getstartPoint obj)) (setq endpt (vlax-curve-getEndPoint obj)) (setq pt1 (cadr ent)) (setq d1 (distance pt1 startpt)) (setq d2 (distance pt1 endpt)) (if (> d1 d2) (setq tmp startpt startpt endpt endpt tmp) ) (setq ang (angle endpt startpt)) (setq tanang (abs (/ (sin ang) (cos ang)))) (setq dist (abs (* 4.0 tanang))) (setq hyp (abs (/ 4.0 (sin (- ang (* 1.5 pi)))))) (setq hypsc (/ hyp 6.25)) (if (< hypsc 1.0)(setq hypsc 1.0)) (setq pt2 (polar startpt ang (+ 2.0 (* hypsc 6.5)))) (setq pt2a (polar startpt ang (+ 2.0 (* hypsc 6.25)))) (cond ((and (>= ang 0.0)(< ang (* pi 0.5)))(AH090)) ((and (> ang 1.5707964267949)(< ang pi ))(AH90180)) ((and (> ang 3.14160265358979)(< ang (* 1.5 pi )))(AH180270)) ((and (> ang 4.71239898038469)(< ang (* 2.0 pi )))(AH2700)) ) (setvar 'osmode oldsnap) (setvar 'cecolor oldcol) (setvar 'angdir oldangdir) (princ) ) (c:bevel)
  13. Comparing rows of text is not a problem it can be done very easy have done many times but this confuses me. How do you pick the two numbers to compare, if it's in order on right examples then must be done in a pick pick manner if its as per "correctly" on right then yes its easy. This one Or this one
  14. andyb57J

    3 X 6m long chords around arc

    This works great. Can you possibly change it to remove the two XLINES that are created and the arc as these are not needed at the end.
  15. Yesterday
  16. andyb57J

    3 X 6m long chords around arc

  17. I haven't looked at the example - weekend and CAD is off, but how many rows do you have to calculate and on how many drawings? Reason I ask is I often find that the rule a LISP operates with are often not perfect and don't accommodate every situation - If the operation I need to do is not excessive then I refer to do it be select row text 1, row 1 text 2 and then place the result, repeat with row 2, and so on Things to also consider is an overkill on the texts to assess to remove duplicates, check that any mtexts are 1 line texts, text 1 or 2 are strings and not numbers, texts are not text or mtext (attributes, blocks, rtexts (they happen), mtexts don't cover both columns, texts don't cover both columns... and many more things that can stop the routine from completing or making a miss match from one column to the next.
  18. Cadkiller

    Bevel (slope) Label

    Here is a drawing with some lines and the bevel symbols that are just made from lines and dimensions. Which I created with a wblock as requested. I hope this is as you requested, Please correct me if it's not the way you wanted. block.dwg
  19. Hi There's a problem with n1 and n2: they're likely referring to texts that are next to each other. But that's unlikely to happen because it depends on the order in which they are found in the database. You should create a function that: 1) compares the texts in the two columns 2) relates each pair of texts because they both have the same x coordinate (with a maximum range of 1/2 the height of both texts) 3) creates a list for each columns sets with the texts in order from highest Y to lowest. Then modify your 'repeat' to iterate over the members of both lists: (nth ind lstColumn1) will always be in the same row as (nth ind lstColumn2)
  20. I try your code. Ithink it works. I will test more. Thanks GLAVCVS
  21. PS: Try it. I haven't done it.
  22. The main function, modified, could be like this: (defun c:test (/ FF FFN TXT TXTS ab d lst rpta) (if (setq d (getfiled "Select file " "" "txt" 0)) (progn (while (not (member (setq rpta (strcase (getstring (strcat "\nConvert Only \'" (setq ab (vl-filename-base d)) ".txt\'? <Only>/All directory: ")))) '("" "O" "A"))) (princ "\n* Invalid option * Try again (ENTER, O or A) ...") ) (if (= rpta "A") (setq lst (vl-directory-files (vl-filename-directory d) "*.txt")) (setq lst (list (strcat ab ".txt"))) ) (foreach ffn lst (setq ff (open (setq ffn (strcat (vl-filename-directory d) "\\" ffn)) "r") txts nil ) (while (setq txt (read-line ff)) (setq txts (cons txt txts)) ) (close ff) (setq txts (mapcar '(lambda (x) (STD-STRSPLIT x "\t,; ")) (reverse txts))) (setq txts (mapcar '(lambda (x) (vl-remove-if '(lambda (y) (and (not (equal "0" y)) (zerop (atof y)))) x ) ) txts ) ) (setq ff (open (strcat (substr ffn 1 (- (strlen ffn) 3)) "pl") "w")) (foreach item txts (write-line (strcat (cadr item) "," (caddr item)) ff) ) (close ff) ) (startapp "explorer" (vl-filename-directory (strcat (vl-filename-directory d) "\\"))) ) ) (princ) )
  23. I need to select two columns with numbers and get the result (difference) in the third column. This code sometimes misidentified the difference, I can't figure out what the reason is. (defun c:Df2Column ( / col1 col2 n1 n2 p1 p2 p3 basept dy txt1 txt2 i ent1 ent2) (princ "\nSelect the texts of the first column: ") (setq col1 (ssget '((0 . "TEXT,MTEXT")))) (if (not col1) (progn (princ "\nThe objects of the first column are not selected.") (exit)) ) (princ "\nSelect the texts of the second column: ") (setq col2 (ssget '((0 . "TEXT,MTEXT")))) (if (not col2) (progn (princ "\nThe objects of the second column are not selected.") (exit)) ) (if (/= (sslength col1) (sslength col2)) (progn (princ "\nThe number of objects in the columns does not match.") (exit)) ) (princ "\nSpecify the insertion point of the third column: ") (setq basept (getpoint)) ;; Defining the step by Y between the elements of the second column (setq ent2a (ssname col2 0)) (setq ent2b (ssname col2 1)) (setq y1 (cadr (cdr (assoc 10 (entget ent2a))))) (setq y2 (cadr (cdr (assoc 10 (entget ent2b))))) (setq dy (- y2 y1)) (setq i 0) (repeat (sslength col1) (setq ent1 (ssname col1 i)) (setq ent2 (ssname col2 i)) (setq txt1 (cdr (assoc 1 (entget ent1)))) (setq txt2 (cdr (assoc 1 (entget ent2)))) (setq n1 (atof txt1)) (setq n2 (atof txt2)) (if (and n1 n2) (progn (setq p3 (list (car basept) (+ (cadr basept) (* i dy)) 0.0)) (entmakex (list (cons 0 "TEXT") (cons 8 (cdr (assoc 8 (entget ent2)))) (cons 10 p3) (cons 40 (cdr (assoc 40 (entget ent2)))) (cons 1 (if (> (- n1 n2) 0) (strcat "+" (rtos (- n1 n2) 2 3)) (rtos (- n1 n2) 2 3))) )) ) ) (setq i (1+ i)) ) (princ) ) difference.dwg
  24. Hi You simply need to get the list of files in that directory with 'vl-directory-files' and create a loop so the code repeats for each file.
  25. Hi. I use this lisp code to convert the form of a txt file from this 0 299153.24 4218596.34 1 299163.21 4218607.51 2 299163.99 4218607.02 3 299176.94 4218599.90 4 299207.37 4218583.27 5 299220.70 4218575.98 6 299242.94 4218563.71 7 299253.41 4218557.75 8 299256.14 4218556.19 9 299253.94 4218553.77 10 299251.66 4218551.25 11 299248.52 4218547.79 12 299244.81 4218549.59 13 299235.68 4218554.00 14 299218.39 4218562.90 15 299197.46 4218573.57 16 299177.72 4218583.74 17 299164.10 4218590.73 18 299153.87 4218596.07 19 299153.24 4218596.34 to 299153.24,4218596.34 299163.21,4218607.51 299163.99,4218607.02 299176.94,4218599.90 299207.37,4218583.27 299220.70,4218575.98 299242.94,4218563.71 299253.41,4218557.75 299256.14,4218556.19 299253.94,4218553.77 299251.66,4218551.25 299248.52,4218547.79 299244.81,4218549.59 299235.68,4218554.00 299218.39,4218562.90 299197.46,4218573.57 299177.72,4218583.74 299164.10,4218590.73 299153.87,4218596.07 299153.24,4218596.34 The code works fine but convert only one file a time. Is it possible to update the code to convert all *.txt files in the folder to *.pl at once . The code I use is (defun c:test (/ FF FFN TXT TXTS) (setq ffn (getfiled "Select file " "" "txt" 0) ff (open ffn "r") txts nil ) (while (setq txt (read-line ff)) (setq txts (cons txt txts))) (close ff) (setq txts (mapcar '(lambda (x) (STD-STRSPLIT x "\t,; ")) (reverse txts))) (setq txts (mapcar '(lambda (x) (vl-remove-if '(lambda (y) (and (not (equal "0" y)) (zerop (atof y)))) x)) txts ) ) (setq ff (open (strcat (substr ffn 1 (- (strlen ffn) 3)) "pl") "w")) (foreach item txts (write-line (strcat (cadr item) "," (caddr item)) ff)) (close ff) (princ) ) ;;; The order of chars in delim is not important. ;;; keeping null tokens, not as with std-strtok. ;;; Might be renamed to std-string-split ;;; by Vladimir Nesterowsky (defun STD-STRSPLIT (s delims / len s1 i c lst) (setq delims (vl-string->list delims) ; fixed len (strlen s) s1 "" i (1+ len) ) (while (> (setq i (1- i)) 0) (setq c (substr s i 1)) (if (member (ascii c) delims) (if (/= i len) ; "1,2," -> ("1" "2") and not ("1" "2" "") (setq lst (cons s1 lst) s1 "" ) ) (setq s1 (strcat c s1)) ) ) (cons s1 lst) ; ",1,2" -> ("" "1" "2") ) I upload some txt files to test the code Thanks 1.txt 2.txt 3.txt
  26. You can read and write direct to Excel. Not sure as to what info you want, it may be simply achieved or very time consuming. You need to look at one task at a time and what are the rules for that task, a recent one is get info 2 blocks, that have same attribute value and say connecting length. Can you post a dwg with individual tasks and expected results in a Excel.
  27. As it’s @lee-mack code he may want to comment.
  28. Yes is answer but you need to add object type into the cond which at moment only looks at line and pline. You need more defund dohatch., doblock. in some other code I make a big list of all objects and values, then look at how many items in each value of the list find maximum and that is used for number of columns. Yes do have something for blocks, any blocks and a table is made, data is sorted and common items counted. Small fee is applicable, would need more code for hatches, lines & plines.
  1. Load more activity
×
×
  • Create New...