Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 01/20/2024 in all areas

  1. I think what BigAl suggested was this (setq v (* (/ (+ s1 s2 (sqrt (* s1 s2))) (* 3. 1000000)) h)) As you see the 3 was changed to 3. or could be 3.0 so you prevent this number can be considered as an integer instead of a real I added the undo and also the initget to prevent h to be 0 or negative or just nil (by hitting enter) ;;; Volume of a truncated piramid square based, author Isaac26a, 19.01.2024 ;;; https://www.cadtutor.net/forum/topic/79210-the-volume-of-the-foundation-ditch-through-lisp/ (defun C:W2d1( / dw h oe pl1 pl2 s1 s2 v) (vl-load-com) (vla-startundomark (setq dw (vla-get-activedocument (vlax-get-acad-object)))) (setq oe (getvar 'cmdecho)) (setvar 'cmdecho 0) (setq pl1 (car (entsel "\nSpecify the polyline PL1:"))) (setq s1 (vla-get-area (vlax-ename->vla-object pl1))) (setq pl2 (car (entsel "\nSpecify the polyline PL2:"))) (setq s2 (vla-get-area (vlax-ename->vla-object pl2))) (initget 7) (setq h (getreal "\nEnter the height (h) of the excavation: ")) (setq v (* (/ (+ s1 s2 (sqrt (* s1 s2))) (* 3. 1000000)) h)) (princ (strcat "\nThe Volume of the excavation is: " (rtos v 2 2) " m3")) (if (setq p (getpoint "\nSpecify a point to insert the text: ")) (entmake (list '(0 . "TEXT") '(100 . "AcDbText") (cons 10 (trans p 1 0)) (cons 40 250) (cons 1 (rtos v 2 3)) (cons 50 (angle '(0 0) (getvar 'ucsxdir))) ) ) (princ (strcat "\nThe result is: " (rtos V 2 3) " m3")) ) (setvar 'cmdecho oe) (vla-endundomark dw) (princ) ) Here when you do "0.333" you are making the number become a string so it will become an error And as far as I know there is no (recip ) function well at least in autocad
    1 point
  2. You can use the following DXF reference: https://help.autodesk.com/view/ACD/2024/ENU/?guid=GUID-235B22E0-A567-4CF6-92D3-38A2306D73F3 I would suggest starting with the ENTITIES section.
    1 point
  3. Like Steven I have gathered these and do use them. Apologise where authors names are not there. Have a look at dims can be a bit of a minefield. I am sure others have similar. entmake functions.lsp
    1 point
  4. Just a quick comment re 1/3 use (/ 1 3.0) forces 0.333333 (/ 1 3) may not returns 0, or (/ 1. 3.) and so on. if you want real answers v's Integers make sure you add a "." to your numbers.
    1 point
  5. Another problem (strcat fname "_S" sht) (setq fname (strcat fname "_S" sht)) Another problem "Y" ctb "Y" you have not defined ctb ? "Y" acad.ctb "Y"
    1 point
  6. wow.... where is the manual???? i long for the good old days when i was learning to program on my C-64. alright, I'm gonna try this... I'm not fast. and trying to wrap my head around this is rough. I started learning LISP about 6 weeks ago, because I had to. <sigh> I'll letcha know what happens. and thank you very much for your help.
    1 point
  7. Here, help yourself... (defun c:polyboundrect ( / ss s1 s2 rect rectx b1 b2 x1 x2 pl p0 p1 p2 p3 ) (prompt "\nSelect LWPOLYLINE or LINE BOUNDARIES and RECTANGLE LWPOLYLINE...") (if (setq ss (ssget "_:L" '((0 . "LWPOLYLINE,LINE")))) (progn (sssetfirst nil ss) (setq s1 (ssget "_I" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1) (90 . 4) (-4 . "<not") (-4 . "<>") (42 . 0.0) (-4 . "not>")))) (sssetfirst nil ss) (setq s2 (ssget "_I" '((-4 . "<or") (0 . "LINE") (-4 . "<and") (0 . "LWPOLYLINE") (-4 . "<not") (-4 . "&=") (70 . 1) (-4 . "not>") (90 . 2) (-4 . "<not") (-4 . "<>") (42 . 0.0) (-4 . "not>") (-4 . "and>") (-4 . "or>")))) (sssetfirst) (setq rect (ssname s1 0)) (setq rectx (entget rect)) (setq b1 (ssname s2 0)) (setq b2 (ssname s2 1)) (setq x1 (car (trans (cdr (assoc 10 (entget b1))) (if (= (cdr (assoc 0 (entget b1))) "LINE") 0 rect) 1))) (setq x2 (car (trans (cdr (assoc 10 (entget b2))) (if (= (cdr (assoc 0 (entget b2))) "LINE") 0 rect) 1))) (setq pl (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 rectx))) rect 1)) (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) rectx)))) (setq p0 (car (vl-sort pl '(lambda ( a b ) (if (= (car a) (car b)) (< (cadr a) (cadr b)) (< (car a) (car b))))))) (setq p1 (car (vl-remove-if-not '(lambda ( x ) (= (cadr x) (cadr p0)) (> (car x) (car p0))) (vl-remove p0 pl)))) (setq p2 (car (vl-remove-if-not '(lambda ( x ) (= (car x) (car p1)) (> (cadr x) (cadr p0))) (vl-remove p1 (vl-remove p0 pl))))) (setq p3 (car (vl-remove p2 (vl-remove p1 (vl-remove p0 pl))))) (if (< x1 x2) (progn (setq p0 (trans (list x1 (cadr p0)) 1 rect)) (setq p1 (trans (list x2 (cadr p1)) 1 rect)) (setq p2 (trans (list x2 (cadr p2)) 1 rect)) (setq p3 (trans (list x1 (cadr p3)) 1 rect)) ) (progn (setq p0 (trans (list x2 (cadr p0)) 1 rect)) (setq p1 (trans (list x1 (cadr p1)) 1 rect)) (setq p2 (trans (list x1 (cadr p2)) 1 rect)) (setq p3 (trans (list x2 (cadr p3)) 1 rect)) ) ) (setq rectx (append (reverse (member (assoc 39 rectx) (reverse rectx))) (list (cons 10 p0) (cons 10 p1) (cons 10 p2) (cons 10 p3)) (list (assoc 210 rectx)))) (entupd (cdr (assoc -1 (entmod rectx)))) ) ) (princ) ) M.R.
    1 point
×
×
  • Create New...