johncav Posted October 31, 2016 Share Posted October 31, 2016 (edited) I wrote a Lisp routine for an M. Sc. 20 years ago but can't get it work, could someone help, it's an experiment based on the work of the architect Alvar Aalto (defun dtr (a) (* pi (/ a 180.0)) ) (defun addz (pos inc / z) (setq z (caddr pos) z (+ inc z) pos (list (car pos) (cadr pos) z) ) ) (defun rnge (bot top) (setq r (rand (- top bot)) r (+ bot r)) ) ; (defun rand (range / x z r) (if (not seed) (setq seed 350)) (setq x (1 + (* seed 2197.0)) z (fix (/ x 4096.0)) seed (fix (- x (* z 4096.0))) r (fix (1 + (abs (* (/ seed 4096.0) (- range 1.0))))) ) ) (defun dvolp (pcn) (setq radb (distance ps pe) angb (angle ps pcn) psb (polar ps ang radb) peb (polar pe (* ang anginc) radb) ) ) ; (defun drawvolp (pcn) (setq radb (distance ps pe) angb (angle ps pcn) psb (polar ps ang radb) peb (polar pe (+ ang anginc) radb) radc (distance psb speb) angc (angle psb speb) angd (angle peb pe) ange (angle ps pe) angf (angle pe ps) angg (angle peb pe) psc (polar psb angc (/ radc 2)) psoa (polar psb angc (/ radc 2)) psob (polar ps angc radc) psn (polar psob ange radc) peoa (polar pe angg (/ radc 2)) peob (polar pe angg radc) pen (polar peob angf radc) htrad1 (distance psc peb) htrad2 (distance psoa peoa) htrad3 (distance psob peob) psnht (addz psn htrad3) psoaht (addz psoa htrad2) pscht (addz psoa htrad1) penht (addz pen htrad3) peoaht (addz peoa htrad2) pebht (addz peb htrad1) ) (command "layer" "m" "line" "c" 5 "" "") (command "3dface" psoa psoaht pscht psc "") (command "3dface" psc pscht pebht peb"") (command "3dface" peb pebht peoaht peoa "") (command "3dface" peoa peoaht penht pen "") (command "3dface" pen penht psnht psn "") (command "3dface" psn psnht psoaht psoa "") (command "3dface" pebht peoaht penht pebht "") (command "3dface" pscht psoaht psnht pscht "") (command "3dface" pebht penht psnht pscht "") ) (defun dvolreg (pcn) (setq radt (fix (* (distance pte pts) (sqrt 2))) anga (angle pts pcn) angb (angle pte pcn) ptsb (polar pts anga radt) pteb (polar pte angb radt) htrad (distance pte pts) ptsht (addz pts htrad) ptsbht (addz ptsb htrad) pteht (addz pte htrad) ptebht (addz pteb htrad) p1val (rnge 1 (fix (/ radt 2.7))) outang (angle pte pts) innang (angle pteb ptsb) ptemid (polar pte outang (/ htrad 2)) ptebmid (polar pteb innang (/ (distance pteb ptsb) 2)) midang (angle ptebmid ptemid) p4val (rnge 1 p1val) npte1 (polar pte angb p4val)) (if (>= cnter 1) (setq npte1 npts1)) (if (= cnter 0) (setq p2val (rnge 1 (fix (/ htrad 6))))) (if (= cnter 0) (setq p3val (rnge 1 p1val))) (setq npte2 (polar npte1 (+ angb (dtr 90)) p2val) npte3 (polar npte2 midang p3val) npts1 (polar pts anga p4val) npts2 (polar npts1 (- anga (dtr 90)) p2val) npts3 (polar npts2 midang p3val) npte1ht (addz npte1 htrad) npte2ht (addz npte2 htrad) npte3ht (addz npte3 htrad) npts1ht (addz npts1 htrad) npts2ht (addz npts2 htrad) npts3ht (addz npts3 htrad)) (command "layer" "m" "line" "c" 5 "" "") (command "3dface" pteb ptebht npte1ht npte1 "") (command "3dface" npte1 npte1ht npte2ht npte2 "") (command "3dface" npte2 npte2ht npte3ht npte3 "") (command "3dface" npte3 npte3ht npts3ht npts3 "") (command "3dface" npts3 npts3ht npts2ht npts2 "") (command "3dface" npts2 npts2ht npts1ht npts1 "") (command "3dface" npts1 npts1ht ptsbht ptsb "") (command "3dface" ptsb ptsbht ptebht pteb "") (command "3dface" ptebht npte1ht npte2ht npte3ht "") (command "3dface" npts3ht npts2ht npts1ht ptsbht "") (command "3dface" ptebht npte3ht npts3ht ptsbht "") (setq pteb ptsb pte pts) ) (defun prog () (command "erase" (ssget "x") "") (command "redraw") (setq small (list 300 300) large (list 1000 1000)) (command "zoom" "w" small large) (command "layer" "m" "arcs" "c" 3 "" "") (setvar "cmdecho" 0) (setvar "pdmode" 35) (setvar "pdsize" 1) (setq pc (getpoint "\nPick a Point: ") rd (getpoint pc "\nPick Radius and Start Angle: ") anginc (getangle "\nEnter Angle in Degrees: ") rad (distance pc rd) ang (angle pc rd) ps (polar pc ang rad) pe (polar pc (+ ang anginc) rad) ) (command "arc" "c" pc ps pe) (setq cntr (fix (/ 360 (atof (angtos anginc)))) cntb (- (/ cntr 2) 1) n "t") (while n (setq speb peb ang (angle pe pc) angrev (angle pc pe) rad (* rad (sqrt 2)) pcb pc pc (polar pe ang rad) ps pe pe (polar pc (+ angrev anginc) rad)) (command "layer" "m" "arcs" "c" 3 "" "") (command "arc" "c" pc ps pe) (if (> cntr cntb) (dvolp pcb)) (if (<= cntr cntb) (drawvolp pcb)) (command "layer" "m" "pnts" "c" 1 "" "") (command "point" pe) (setq cntr (- cntr 1)) (if (= cntr 0) (setq n nil)) (command "layer" "m" "arcs" "c" 3 "" "") (command "arc" "c" pc ps pe) ) (command "zoom" "e") ) (defun reg () (command "erase" (ssget "x") "") (setq small (list 300 300) large (list 1000 1000)) (command "zoom" "w" small large) (command "redraw") (command "layer" "m" "arcs" "c" 3 "" "") (setvar "cmdecho" 0) (setvar "pdmode" 35) (setvar "pdsize" 1) (setq pc (getpoint "\nPick a Point: ") rd (getpoint pc "\nPick Radius and Start Angle: ") anginc (getangle "\nEnter Angle in Degrees: ") seed (getreal "\nEnter Seed: ") pc1 pc rad (distance pc rd) ang (angle pc rd) ps (polar pc ang rad) pe (polar pc (+ ang anginc) rad)) (command "pline") (setq cntr (fix (/ 360 (atof (angtos anginc)))) cntb (/ cntr 2) n "t") (while n (setq ang (angle pe pc) angrev (angle pc pe) rad (* rad (sqrt 2)) pcb pc pc (polar pe ang rad) ps pe pe (polar pc (+ angrev anginc) rad)) (if (<= cntr cntb) (command ps "arc" "ce" pc pe)) (if (= cntr cntb) (setq ps1 ps)) (setq cntr (- cntr 1)) (if (< cntr 0) (setq n nil)) ) (command "") (command "line" ps1 pe "") (command "layer" "m" "pnts" "c" 1 "" "") (command "zoom" "e" "") (command "divide" ps (rnge 5 15)) (setq pte pe ss1 (ssget "x" (list (cons 0 "point"))) num (sslength ss1) cnter 0) (repeat num (setq pts (cdr (assoc 10 (entget (ssname ss1 cnter))))) (dvolreg pcb) (setq cnter (1+ cnter)) ) (command "zoom" "e") ) (defun c:try () (initget "Prog Reg") (setq answer (getkword "\nWhat do you want <Prog/Reg>? ")) (cond ((= answer "Prog") (prog)) ((= answer "Reg") (reg)) ) ) Edited January 15, 2018 by SLW210 Code Tags added. Quote Link to comment Share on other sites More sharing options...
Roy_043 Posted October 31, 2016 Share Posted October 31, 2016 Please read: http://www.cadtutor.net/forum/showthread.php?9184-Code-posting-guidelines I notice two things: 1. (command "erase" (ssget "x") "") Should be: (if (setq ss (ssget "x")) (command "erase" ss "")) 2. (1 + ...) Should be (2x): (1+ ...) Quote Link to comment Share on other sites More sharing options...
Grrr Posted October 31, 2016 Share Posted October 31, 2016 I would wrote the main function like this: (defun c:test ( / answer ) (initget "Prog Reg") (or (setq answer (getkword "\nWhat do you want [Prog/Reg] <Prog> ? ")) (setq answer "Prog")) (cond ((and (= answer "Prog") (= 'SUBR (type prog))) (princ "\nChoosed: Prog") (prog)) ((and (= answer "Reg") (= 'SUBR (type reg))) (princ "\nChoosed: Reg") (reg)) ) (princ) ) And these subfunctions like this: (defun addz (pos inc / z) (and pos (listp pos) (numberp inc) (setq pos (list (car pos) (cadr pos) (+ inc (caddr pos)))) ) pos ) (defun rnge (bot top) (and (apply 'and (mapcar 'numberp (list bot top))) (setq r (+ bot (rand (- top bot)))) ) r ) (defun rand (range / x z r) (and (or (numberp seed) (setq seed 350)) (numberp range) (setq x (1+ (* seed 2197.0))) (setq z (fix (/ x 4096.0))) (setq seed (fix (- x (* z 4096.0)))) (setq r (fix (1+ (abs (* (/ seed 4096.0) (- range 1.0)))))) ) r ) (defun dvolp (pcn) (and pcn (listp pcn) (apply 'and (mapcar 'numberp pcn)) (setq radb (distance ps pe)) (setq angb (angle ps pcn)) (setq psb (polar ps ang radb)) (setq peb (polar pe (* ang anginc) radb)) ) peb ) Although I am not sure whats up with the global arguments, so I didn't touched them (just provided additional checks in these subfunctions). And also these rows like inside of the (drawvolp) function: (command "layer" "m" "line" "c" 5 "" "") (command "3dface" psoa psoaht pscht psc "") (command "3dface" psc pscht pebht peb"") (command "3dface" peb pebht peoaht peoa "") (command "3dface" peoa peoaht penht pen "") (command "3dface" pen penht psnht psn "") (command "3dface" psn psnht psoaht psoa "") (command "3dface" pebht peoaht penht pebht "") (command "3dface" pscht psoaht psnht pscht "") (command "3dface" pebht penht psnht pscht "") IMO, is better to be written like this: (command "_.LAYER" "m" "line" "c" 5 "" "" "_.3DFACE" "_non" psoa "_non" psoaht "_non" pscht "_non" psc "" "_.3DFACE" "_non" psc "_non" pscht "_non" pebht "_non" peb "" "_.3DFACE" "_non" peb "_non" pebht "_non" peoaht "_non" peoa "" "_.3DFACE" "_non" peoa "_non" peoaht "_non" penht "_non" pen "" "_.3DFACE" "_non" pen "_non" penht "_non" psnht "_non" psn "" "_.3DFACE" "_non" psn "_non" psnht "_non" psoaht "_non" psoa "" "_.3DFACE" "_non" pebht "_non" peoaht "_non" penht "_non" pebht "" "_.3DFACE" "_non" pscht "_non" psoaht "_non" psnht "_non" pscht "" "_.3DFACE" "_non" pebht "_non" penht "_non" psnht "_non" pscht "" ) And also, when you write setq-s like this: (setq pc (getpoint "\nPick a Point: ") rd (getpoint pc "\nPick Radius and Start Angle: ") anginc (getangle "\nEnter Angle in Degrees: ") seed (getreal "\nEnter Seed: ") ... ) This would evaluate only the last setq variable (as Tharwat taught me), which in your case is: ... pe (polar pc (+ ang anginc) rad) So I would suggest the classical way to separate the prompts for user inputs, from the rest variables that the routine proceeds with: (if (and (setq pc (getpoint "\nPick a Point: ")) (setq rd (getpoint pc "\nPick Radius and Start Angle: ")) (setq anginc (getangle "\nEnter Angle in Degrees: ")) (setq seed (getreal "\nEnter Seed: ")) ) (progn (setq pc1 pc rad (distance pc rd) ang (angle pc rd) ps (polar pc ang rad) pe (polar pc (+ ang anginc) rad) ) ... ); progn ); if Sorry, no full revision - the global variables passing thru the subfuncs and these calculations are confusing for me Quote Link to comment Share on other sites More sharing options...
johncav Posted October 31, 2016 Author Share Posted October 31, 2016 Thank you so much, when I get it working I'll send you a copy Quote Link to comment Share on other sites More sharing options...
johncav Posted October 31, 2016 Author Share Posted October 31, 2016 Hi again, if you send me an email address I'll post you a copy of the paper I wrote so that you can get the full gist of how it used to work, many thanks for your help this morning, john.cavendish@gmail.com Quote Link to comment Share on other sites More sharing options...
Grrr Posted November 1, 2016 Share Posted November 1, 2016 Hi again, if you send me an email address I'll post you a copy of the paper I wrote so that you can get the full gist of how it used to work, many thanks for your help this morning, john.cavendish@gmail.com Just upload what do you have in here (cadtutor). We are not the only guys who can help you. Quote Link to comment Share on other sites More sharing options...
johncav Posted November 1, 2016 Author Share Posted November 1, 2016 the paper is in a pdf attached Quote Link to comment Share on other sites More sharing options...
johncav Posted November 1, 2016 Author Share Posted November 1, 2016 second part of the paper Quote Link to comment Share on other sites More sharing options...
johncav Posted November 1, 2016 Author Share Posted November 1, 2016 the code you already have seen Quote Link to comment Share on other sites More sharing options...
johncav Posted January 14, 2018 Author Share Posted January 14, 2018 i got it working Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.