phuynh Posted April 30, 2020 Posted April 30, 2020 (edited) My goal as follow: I have 3d solid model in AutoCAD output to 2D dimetric which know scale ratio by using flatshot so later on easy for revising or re-editing in my lisp routine, I prompt for user input on scale ratio options which are 1-half, 2-third, 3-quarter and "Other" scale (between 0 and 1) in av:getUserInput although "Other" option works when user enter real number but I how can I re-display the real number next time user re-execute the command? Sorry for long code, anyone help wound be thankful! ;;################################################;; ;; Lisp setup axonometric view point in 3d space ;; ;; with known scale ratio between 0 and 1.0 ;; ;; Phong Huynh ;; ;; avp.lsp ;; ;; ;; ;; Thanks for infomation of the follwing websites ;; ;; compuphase.com/axometr.htm ;; ;; en.wikipedia.org/wiki/Axonometric_projection ;; ;; tamivox.org/redbear/axono/index.html ;; ;; cadtutor.net ;; ;; lee-mac.com ;; ;;################################################;; (vl-load-com) (princ) (defun c:avp (/ vptData aViewPoint old_cmdecho old_osmode old_color old_lweight e1 e2 e3 zoomscalefac strfac) ;;Start error traperr & save vars. (setq temperr *error*) (setq *error* traperr) (setq old_cmdecho (getvar "CMDECHO")) (setq old_osmode (getvar "OSMODE")) (setq old_color (getvar "CECOLOR")) (setq old_lweight (getvar "CELWEIGHT")) (if (setq vptData (av:getUserInput)) (progn (setvar "OSMODE" 0) (setvar "CMDECHO" 0) (setq e1 1.0) (setq e2 1.0) (setq e3 (av:e3calc global:rScale)) (setq zoomscalefac (sqrt (* 0.5 (+ (* 1.0 1.0) (* 1.0 1.0) (* global:rScale global:rScale))))) (setq strfac (rtos zoomscalefac 2 16)) ;; Setup view point location (if (eq global:zhori "Above") (cond ((eq global:xydir "Sse") (setq aViewPoint (list e1 (* e3 -1.0) e2)) ) ((eq global:xydir "Ees") (setq aViewPoint (list e3 (* e1 -1.0) e2)) ) ((eq global:xydir "Een") (setq aViewPoint (list e3 e1 e2)) ) ((eq global:xydir "Nne") (setq aViewPoint (list e1 e3 e2)) ) ((eq global:xydir "Nnw") (setq aViewPoint (list (* e1 -1.0) e3 e2)) ) ((eq global:xydir "Wwn") (setq aViewPoint (list (* e3 -1.0) e1 e2)) ) ((eq global:xydir "Wws") (setq aViewPoint (list (* e3 -1.0) (* e1 -1.0) e2)) ) ((eq global:xydir "Ssw") (setq aViewPoint (list (* e1 -1.0) (* e3 -1.0) e2)) ) ) (cond ((eq global:xydir "Sse") (setq aViewPoint (list e1 (* e3 -1.0) (* e2 -1.0))) ) ((eq global:xydir "Ees") (setq aViewPoint (list e3 (* e1 -1.0) (* e2 -1.0))) ) ((eq global:xydir "Een") (setq aViewPoint (list e3 e1 (* e2 -1.0))) ) ((eq global:xydir "Nne") (setq aViewPoint (list e1 e3 (* e2 -1.0))) ) ((eq global:xydir "Nnw") (setq aViewPoint (list (* e1 -1.0) e3 (* e2 -1.0))) ) ((eq global:xydir "Wwn") (setq aViewPoint (list (* e3 -1.0) e1 (* e2 -1.0))) ) ((eq global:xydir "Wws") (setq aViewPoint (list (* e3 -1.0) (* e1 -1.0) (* e2 -1.0))) ) ((eq global:xydir "Ssw") (setq aViewPoint (list (* e1 -1.0) (* e3 -1.0) (* e2 -1.0))) ) ) ) (vl-cmdf "_vpoint" aViewPoint) (princ "\nDebug info's\nZoom scale factor to match AutoCAD unit: ") (princ strfac) (princ "\n") (princ "Note: e1 = e2 = 1.0, e3 = ") (princ e3) ) (princ) ) (setvar "CMDECHO" old_cmdecho) (setvar "OSMODE" old_osmode) (setvar "CECOLOR" old_color) (setvar "CELWEIGHT" old_lweight) (princ) ) ;;-------------------------------------;; ;; Function to get user input keywords ;; ;;-------------------------------------;; (defun av:getUserInput (/ dScale rScale xydir zhori tmp0 tmp1 tmp2 time) ;; dScale - global: hold default scale ratio keyword when prompt user for input. ;; rScale - global: scale ratio, real number must be between 0 and 1. ;; xydir - keyword: view direction from xy plane. ;; zhori - keyword: view direction from z plan, above or below horizon ;; temp0 - temporary variable 0 ;; temp1 - temporary variable 1 ;; temp2 - temporary variable 2 ;; time - temporary variable (if (null global:dScale) (setq global:dScale "3-quarter") ) (initget "1-half 2-third 3-quarter Other") (if (setq tmp0 (getkword (strcat "\nScale ratio [1-half/2-third/3-quarter/Other] <" global:dScale ">: "))) (cond ((= tmp0 "1-half") (setq global:dScale tmp0) (setq global:rScale 0.5) ) ((= tmp0 "2-third") (setq global:dScale tmp0) (setq global:rScale (/ 2.0 3.0)) ) ((= tmp0 "3-quarter") (setq global:dScale tmp0) (setq global:rScale 0.75) ) ((= tmp0 "Other") (setq global:dScale tmp0) ;;--------------Thank to "rkmcswain" @ cadtutor.net/forum --------- (setq time T) (while time (setq global:rScale (getreal (strcat "\nEnter scale ratio: "))) (if (and (> global:rScale 0.0) (<= global:rScale 1.0)) (setq time nil) ) ) ;;----------------------------------------------------------------- ) ) ) (if (null global:zhori) (setq global:zhori "Above") ) (initget "Above Below") (if (setq tmp1 (getkword (strcat "\nView angle [Above/Below] Horizon <" global:zhori ">: "))) (setq global:zhori tmp1) ) (if (null global:xydir) (setq global:xydir "Sse") ) (initget "Sse Ees Een Nne Nnw Wwn Wws Ssw") (if (setq tmp2 (getkword (strcat "\nLocation on XY Plane [Sse/Ees/Een/Nne/Nnw/Wwn/Wws/Ssw] <" global:xydir ">: " ) ) ) (setq global:xydir tmp2) ) (list global:dScale globle:rScale global:zhori global:xydir) ) ;;---------------------------------------;; ;; Function calculate e3 (element e3) ;; ;;---------------------------------------;; ;; Thank Dave Barber http://tamivox.org ;; ;; for axonometric calculator formulars ;; ;;---------------------------------------;; (defun av:e3calc (m / e1 e2 e3 Lr Cr Rr Ls Cs Rs Li Ci Ri Dr Lu Cu Ru Dd) (setq e1 1.0) (setq e2 1.0) (setq e3 m) (setq Lr 1.0) (setq Cr 1.0) (setq Rr e3) (setq Dr (sqrt (* 0.5 (+ (* Lr Lr) (* Cr Cr) (* Rr Rr))))) (setq Ls (/ Lr Dr)) (setq Cs (/ Cr Dr)) (setq Rs (/ Rr Dr)) (setq Lu (- 1.0 (* Ls Ls))) (setq Cu (- 1.0 (* Cs Cs))) (setq Ru (- 1.0 (* Rs Rs))) (setq Li (atan (sqrt (/ (* Lu Cu) Ru)))) (setq Ci (atan (sqrt (/ (* Ru Lu) Cu)))) (setq Ri (atan (sqrt (/ (* Cu Ru) Lu)))) (setq Dd (sqrt (- (/ 1.0 (sin Li)) Lr))) ) ;;----------------------------------------------;; ;; Error traper function restore save variables ;; ;;----------------------------------------------;; (defun traperr (errmsg) (setvar "CMDECHO" old_cmdecho) (setvar "OSMODE" old_osmode) (setvar "CECOLOR" old_color) (setvar "CELWEIGHT" old_lweight) (setq *error* temperr) (prompt "\Resetting system variables ") (princ) ) Edited April 30, 2020 by phuynh correct post topic 1 Quote
phuynh Posted April 30, 2020 Author Posted April 30, 2020 Anyone improve code are welcome! and thanks! Quote
hanhphuc Posted May 1, 2020 Posted May 1, 2020 (edited) 7 hours ago, phuynh said: although "Other" option works when user enter real number but I how can I re-display the real number next time user re-execute the command? Thanks for sharing^^ rkmcswain's global:rScale (setq time T ) (initget 6) (while time (setq rScale (cond ((getreal (strcat "\nEnter scale ratio < " (cond (global:rScale (rtos global:rScale 2)) ("1.0") ) " > : "))) (global:rScale) (1) ) ) (if (and (> rScale 0.0) (<= rScale 1.0)) (setq global:rScale rScale time nil) ) ) or (while (> (setq global:rScale (ureal 6 "" "Enter scale ratio" (cond (global:rScale)(1)) )) 1) (princ "\nInput range 0 < x < 1.00 ") ) UREAL ;This function is freeware courtesy of the author's of "Inside AutoLisp" for rel. 10 published by New Riders Publications. ;credit must accompany all copies of this function. ;;;October 19, 2004 added function chkkwds (see description at end of file) ;* UREAL User interface real function ;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET. ;* MSG is the prompt string, to which a default real is added as <DEF> (nil ;* for none), and a : is added. ;* (defun ureal (bit kwd msg def / inp) (if def (setq msg (strcat "\n" msg " <" (if (eq (type def) 'REAL)(rtos def 2)(if (eq (type def) 'INT)(itoa def)def)) ">: ") bit (* 2 (fix (/ bit 2))) ) (setq msg (strcat "\n" msg ": ")) );if (initget bit kwd) (setq inp (getreal msg)) (if inp inp def) );defun Edited May 1, 2020 by hanhphuc rkmcswain's if statement Quote
phuynh Posted May 1, 2020 Author Posted May 1, 2020 Thank ' hanhphuc' for sharing the code, I will look to improve my scripts. Thanks! Quote
phuynh Posted May 1, 2020 Author Posted May 1, 2020 Hello everyone! First, I would like to thank for your help on previous post! I have an other lisp routine need to work out, instead of start new topic so I continue to post it here. The goal is try to detect AutoCAD current view whether dimetric or trimetric view by valuate AutoCAD system variable VIEWDIR in which x,y,z if any 2 of elements are same (absolute) value then it is dimetric, otherwise it is trimetric, and return the unique & common element in "uniq" & "comm" variables. The code as follow: (defun c:vdetect (/ vdata ee1 ee2 ee3 ans comm uniq) (setq vdata (getvar "VIEWDIR")) (setq ee1 (abs (car vdata))) (setq ee2 (abs (cadr vdata))) (setq ee3 (abs (caddr vdata))) (progn (if (or (= ee1 ee2) (= ee1 ee3) ) (setq ans "View is dimetric") (setq ans "View is trimetric") ) ) ) in "or" statment should I be able to add more valueation? and return the unique or common element among them! Thanks, Quote
hanhphuc Posted May 1, 2020 Posted May 1, 2020 5 hours ago, phuynh said: x,y,z if any 2 of elements are same in "or" statment should I be able to add more valueation? and return the unique or common element among them! Thanks, (defun foo (/ x y z) (mapcar 'set '(x y z) (mapcar 'abs (getvar 'viewdir))) (if (or (= x y)(= x z)(= y z)) "dimetric" "trimetric") ) (foo) Quote
phuynh Posted May 2, 2020 Author Posted May 2, 2020 I sovle the problem, however the my code realy long! Your tip much better, it is short and easy to understand! Thank you! Quote
phuynh Posted May 2, 2020 Author Posted May 2, 2020 (edited) Lisp with flatshot command to create 2D drawing, with various properties change, update such as bylayer, lineweight etc.. Also this lisp routine would detect if current view is a dimetric view, then scale all entities in block according to match AutoCAD current unit. Math functions may have bugs!, coding by no mean expert, if anyone can help to improve are welcome! ;;######################################################################;; ;; fsa.lsp (flatshot axonometric.. couldn't come up with good name) ;; ;; Phong Huynh ;; ;; ;; ;; Lisp to create 2D drawing from 3D solid model using AutoCAD flatshot ;; ;; Scaling entities in block necessary to match current AutoCAD unit. ;; ;; ;; ;; Also change various properties after flatshot create block. ;; ;; This fsa.lsp means to run after avp.lsp (see avp.lsp) ;; ;; work-in-progress ;; ;; ;; ;; Downside Note: ;; ;; When flatshot dialog come up - if Obscured lines checked, the ;; ;; Linetype dropbox below must be selected "HIDDEN". ;; ;; For complex solid model with obcured lines enable, it takes abit ;; ;; long to finish due to scaling if current view is dimetric view. ;; ;; Can't find way to run script silent due to nature of ;; ;; flatshot command ;; ;; ;; ;; Thanks cadtutor forum users for help & tips ;; ;; ;; ;;######################################################################;; (defun c:fsa (/ ss ltsc scfactor basept blk eo doc blocks bcol sc old_cmdecho old_osmode old_color old_lweight) ;;Start error traperr & save vars. (setq temperr *error*) (setq *error* traperr) (setq old_cmdecho (getvar "CMDECHO")) (setq old_osmode (getvar "OSMODE")) (setq old_color (getvar "CECOLOR")) (setq old_lweight (getvar "CELWEIGHT")) ;; Check & create new layer name 251 for hidden lines ;; with color 251, lineweigth 0.09mm and linetype hidden (if (not (tblsearch "layer" "251")) (vl-cmdf "layer" "n" "251" "C" "251" "251" "LW" "0.09" "251" "LT" "HIDDEN" "251" "ON" "251" "" ) ) (if (and ;; Set linetype scale, AutoCAD defaul 1.0 (setq ltsc "0.5") ;; Dimetric view check if true ;; set scfactor for scaling entities after flat shot create block (setq sc (fs:dvCheck)) (if (null sc) (setq scfactor 1.0) (setq scfactor sc) ) (setq basept (vlax-3d-point 0 0 0)) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (setvar "OSMODE" 0) (setvar "CMDECHO" 0) (vl-cmdf "_.FLATSHOT" '(0.0 0.0 0.0) "" "" "") (setvar "CMDECHO" old_cmdecho) (setvar "OSMODE" old_osmode) (princ) (setq ss (ssget "L")) (setq ss (vla-get-ActiveSelectionSet doc)) ) (progn (vlax-for eo ss (if (vlax-property-available-p eo 'LinetypeScale t) (vla-put-LinetypeScale eo ltsc) ) (if (eq (vla-get-Linetype eo) "HIDDEN") (vla-put-Layer eo "251") ) (if (and (eq (vla-get-ObjectName eo) "AcDbBlockReference") (not (vl-position (vla-get-EffectiveName eo) blocks)) ) (setq blocks (cons (vla-get-EffectiveName eo) blocks)) ) ) (setq bcol (vla-get-Blocks doc)) (foreach blk blocks (vlax-for eo (vla-Item bcol blk) ;; if scfactor /= 1.0 then do scale (if (/= scfactor 1.0) (vla-ScaleEntity eo basept scfactor) ) (if (vlax-property-available-p eo 'LinetypeScale t) (vla-put-LinetypeScale eo ltsc) ) (if (vlax-property-available-p eo 'Color t) (vla-put-color eo "256") ) (if (vlax-property-available-p eo 'Lineweight t) (vla-put-LineWeight eo "-1") ) (if (eq (vla-get-Linetype eo) "HIDDEN") (vla-put-Layer eo "251") ) ) ) (vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport ) ) ) (princ) ) ;;-----------------------------------;; ;; Function compute zoomscale ratio ;; ;;-----------------------------------;; (defun fs:dvCheck (/ x y z ans) ;; Check current view whether dimetric or not (mapcar 'set '(x y z) (mapcar 'abs (getvar 'viewdir))) (if (and (not (= 0 (apply 'min (list x y z)))) (not (equal (apply 'max (list x y z)) (apply 'min (list x y z)) 0.000001 ) ) (or (= x y) (= x z) (= y z)) ) (setq ans (fs:compuScale (apply 'max (list x y z)))) (setq ans 1.0) ) ) ;;-----------------------------------;; ;; Function compute zoomscale ratio ;; ;;-----------------------------------;; (defun fs:compuScale (m / e1 e2 e3 Lr Cr Rr Ls Cs Rs Li Ci Ri Dr Lu Cu Ru Dd) (setq e1 1.0) (setq e2 1.0) (setq e3 m) (setq Ri (asin (/ 1 (+ (expt e3 2) e1)))) (setq Ci (/ (- (/ pi 2.0) Ri) 2.0)) (setq Li (/ (- (/ pi 2.0) Ri) 2.0)) (setq Rs (sqrt (- 1.0 (* (tan Ri) (tan Ci))))) (setq Cs (sqrt (- 1.0 (* (tan Ri) (tan Li))))) (setq Ls (sqrt (- 1.0 (* (tan Li) (tan Ci))))) (setq Dr (/ 1.0 Rs)) ) ;;-----------------;; ;; asin function ;; ;;-----------------;; (defun asin (y) (atan y (sqrt (- 1 (* y y)))) ) ;;-----------------;; ;; tan function ;; ;;-----------------;; (defun tan (x) (cond ((equal (cos x) 0.0 1.0e-16) (if (minusp x) -1.0e200 1.0e200 ) ) (T (/ (sin x) (cos x)) ) ) ) ;;----------------------------------------------;; ;; Error traper function restore save variables ;; ;;----------------------------------------------;; (defun traperr (errmsg) (setvar "CMDECHO" old_cmdecho) (setvar "OSMODE" old_osmode) (setvar "CECOLOR" old_color) (setvar "CELWEIGHT" old_lweight) (setq *error* temperr) (prompt "\Resetting system variables ") (princ) ) Edited May 2, 2020 by phuynh remove unuse variables comm & uniq Quote
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.