meinfilel Posted September 7, 2021 Posted September 7, 2021 Hello everyone, I've made this small AutoLISP routine so I can easily move objects on axis that aren't parallel to WCS or just define new axis. User is prompted to select which one wants to be done (just define new X axis OR define new X axis and move an object that will select); I'm trying to do this using initget with getkword. If user enters F routine will exit after defining the new axis; instead, if T is given as input a new axis will be defined and user will be asked toselect objects to move. I can call function and give T (axis+move) as many times I want, but after calling it and giving F, new axis is defined as planned, but something is happening as this point. I try to call function again after F is given, but I get error that wrong input is given. Any idea why this is happening? Maybe it has to do with the errorhandling function (error1)? I'm attaching the .lsp file with a simple dwg I use for tests on this routine. Thanks in advance for your time. new_x_axis_beta.lsp Drawing1.dwg Quote
tombu Posted September 7, 2021 Posted September 7, 2021 I'd recommend simply using a localized *error* function that wouldn't affect any other lisp routines. initget (AutoLISP) https://help.autodesk.com/view/ACD/2022/ENU/?guid=GUID-9ED8841B-5C1D-4B3F-9F3B-84A4408A6BBF Keyword Specifications The string argument is interpreted according to the following rules: Each keyword is separated from the following keyword by one or more spaces. For example, "Width Height Depth" defines three keywords. Each keyword can contain only letters, numbers, and hyphens (-). getkword (AutoLISP) https://help.autodesk.com/view/ACD/2022/ENU/?guid=GUID-9F940144-0D7B-4DA1-BF50-BBF8FB8DFF21 Valid keywords are set prior to the getkword call with the initget function. Try (initget 1 "Yes No") (setq ans (strcase (getkword "\nDefine and Move? (Yes or No) "))) Quote
meinfilel Posted September 7, 2021 Author Posted September 7, 2021 54 minutes ago, tombu said: I'd recommend simply using a localized *error* function that wouldn't affect any other lisp routines. initget (AutoLISP) https://help.autodesk.com/view/ACD/2022/ENU/?guid=GUID-9ED8841B-5C1D-4B3F-9F3B-84A4408A6BBF Keyword Specifications The string argument is interpreted according to the following rules: Each keyword is separated from the following keyword by one or more spaces. For example, "Width Height Depth" defines three keywords. Each keyword can contain only letters, numbers, and hyphens (-). getkword (AutoLISP) https://help.autodesk.com/view/ACD/2022/ENU/?guid=GUID-9F940144-0D7B-4DA1-BF50-BBF8FB8DFF21 Valid keywords are set prior to the getkword call with the initget function. Try (initget 1 "Yes No") (setq ans (strcase (getkword "\nDefine and Move? (Yes or No) "))) Isn't now my error function localized? I've set the name error1 in the line defun c:routinename ( / error1 [..] ) after defining (setq error1 *error*). Also, I've replaced initget and getkword with your recommendation but got same results; routine gives error after giving the option making it to only define axis. I've commented out error function, but it doesn't seem to matter at all. Thanks for your time! Quote (defun c:6 ( / smallangle elementorlist clstpoint pairvertices ortho_backup osmode_backup grid_mode ss pp1 pp2 ptslist x ) ;v2 - sept '21 ; user selects a line/polyline to be used as the new X axis ; move command gets called ; without any snaps and with ORTHO on ; after move command, WCS is returned ;;;(setq error1 *error*) (vl-load-com) ;;;;;; === error function ===== ;;; (defun error1 (msg) ;;; (setvar "osmode" osmode_backup) ;;; (setvar "orthomode" ortho_backup) ;;; (setvar "gridmode" grid_mode) ;;; (command-s "ucs" "World") ;;; ;;; (princ "\nEsc button was pressed.") ;;; ;;; (princ) ;;; ) ; error defun ;subroutines used: smallangle, elementorlist, pairvertices, clstpoint (defun smallangle ( pt1 pt2 / ang1 ang2 ) ;gets two points as input ;it returns the smallest angle between them (setq ang1 (angle pt1 pt2) ang2 (angle pt2 pt1) ) (if (< ang1 ang2) ang1 ang2 ) ;if ); defun smallangle (defun elementorlist ( pnts ) ;;; takes as argument one of the following ;;; and returns the corresponding message ;;; !! a and b must be numbers !! ;;;- a or (a)-> elmnt (single element) ;;;- (a b) -> slist (simple list) ;;;- ( (a b) (c d)) -> clist (complex list) ;;;- ( ( (a1 b1) (a2 b2) ) ( (c1 d2) (c2 d2) ) ) -> sclist (super complex list) (if (or (eq (type pnts) (READ "INT")) (eq (TYPE X) (READ "REAL")) ) ;OR (setq pnts (list pnts)) (princ) ) (cond ( (AND (eq (length pnts) 1 ) (vl-every '(lambda (x) (or (eq (TYPE X) (READ "REAL")) (eq (TYPE X) (READ "INT")) ) ) pnts) ) ;AND "elmnt" ) ( (vl-every '(lambda (x) (or (eq (TYPE X) (READ "REAL")) (eq (TYPE X) (READ "INT")) ) ;or ) pnts) "slist") ( (AND (vl-every '(lambda (x) (eq (TYPE X) (READ "list"))) pnts ) (vl-every '(lambda (x) (eq (TYPE (car X)) (READ "list") ) ) pnts ) ) ;AND "sclist" ) (T "clist") ) ;cond ) (defun clstpoint ( / ent testpoint entityy pts miin lst nearestpt a b ) ;gets as input a pline or line and pick point ;returns the vertex that is "closest" to the pick point ;"closest" in terms of defining a new X axis (setq ent (entsel "pick new x axis") entityy (entget (car ent)) testpoint (cadr ent) ) (setq testpoint (vlax-curve-getclosestpointto (vlax-ename->vla-object (car ent)) testpoint)) (if (wcmatch (cdr (assoc 0 entityy)) "LINE") (progn (setq nearestpt (list (cadr (assoc 10 entityy)) (caddr (assoc 10 entityy))) ) ) ;progn if line is selected (progn ;testpoint is now actually *on* the pline/line ;(drwpoint testpoint) -DEBUG (setq pts nil) (while (assoc 10 entityy) ;loop until there is no point (10 dxf group code) remaining (setq pts (append pts (list (cdr (assoc 10 entityy))))) (setq entityy (cdr (member (assoc 10 entityy) entityy))) (princ) ) (foreach k (pairvertices pts) (if (equal (smallangle testpoint (car k)) (smallangle testpoint (cadr k)) 0.1) ;eq (setq nearestpt (car k)) ) ;if ) ;foreach ) ;progn if pline is selected ) ; if (list testpoint nearestpt) ) (defun pairvertices ( lst / 1p ) ;accepts only clist ; make list ( (a b) (c d) (d e) ) -> ; ( ( (a b) (b c) ) ((b c) (c d) ) ( (c d) (d e) ) (if (eq (elementorlist lst) "clist" ) (progn (if (eq (length lst) 2) ;if only two points are in the vertices list, do nothing pts (progn (repeat (- (length lst) 1) (setq 1p (append 1p (list (list (nth 0 lst) (nth 1 lst))) ) ) (setq lst (cdr (member (nth 0 lst) lst))) ;read from here ) 1p ) ;progn if vertices list has more than 2 points ) ;if ) ;progn if clist is fed (progn (princ "\nWrong Input. Exiting.") (exit) ) ;progn in anything but clist is fed ) ;if ) ;;;=================================================================;;;;;; (initget 1 "Yes No") (setq ans (strcase (getkword "\nDefine and Move? (Yes or No) "))) (command "UNDO" "BE") ;undo from this point will undo everything (setq ortho_backup (getvar "orthomode") osmode_backup (getvar "osmode") grid_mode (getvar "gridmode") ) ;setq (setvar "orthomode" 0) (setvar "gridmode" 0) (setvar "osmode" 0) ;43 ) ; 43 osmode = endpoint, midpoint, node, intersection (setq ptslist (clstpoint) pp1 (trans (car ptslist) 0 1) pp2 (trans (cadr ptslist) 0 1) ) ;setq (command "_.ucs" "_3p" "_non" ;no object snap for next point pp1 "_non" pp2 "") ;command (if (eq ans "YES") (progn (setvar "osmode" osmode_backup) (setvar "orthomode" ortho_backup) (setvar "gridmode" grid_mode) (setvar "orthomode" 1) (setvar "osmode" 0) (if (setq ss (ssget "_:L-I")) (command "_.move" ss "" "_none" pause pause) ;command (progn ;print that no selection was made (princ "\nNo selection was made for move command. Exiting.\n" ) (princ) ) ;progn ) ;if selection is made (command "ucs" "World") );progn ) ;if move command needs to be called (command "UNDO" "END") ;undo until here acts as one thing (setvar "osmode" osmode_backup) (setvar "orthomode" ortho_backup) (setvar "gridmode" grid_mode) ) ;defun 6 // new X axis Quote
meinfilel Posted September 7, 2021 Author Posted September 7, 2021 6 hours ago, meinfilel said: Isn't now my error function localized? I've set the name error1 in the line defun c:routinename ( / error1 [..] ) after defining (setq error1 *error*). Also, I've replaced initget and getkword with your recommendation but got same results; routine gives error after giving the option making it to only define axis. I've commented out error function, but it doesn't seem to matter at all. Thanks for your time! It seems that selecting point on an arbitary system caused the problem. So my solution was to check if WCS is active or some user-defined system, and restore WCS before proceeding with the routine. I attach the code that finally worked and noting the changle with bold letters. Thanks! Quote (defun c:6 ( / *error* smallangle elementorlist clstpoint pairvertices ortho_backup osmode_backup grid_mode ss pp1 pp2 ptslist x ) ;v2 - sept '21 ; user selects a line/polyline to be used as the new X axis ; move command gets called ; without any snaps and with ORTHO on ; after move command, WCS is returned (vl-load-com) ;;;;;; === error function ===== (defun *error* (msg) (setvar "osmode" osmode_backup) (setvar "orthomode" ortho_backup) (setvar "gridmode" grid_mode) (command-s "ucs" "World") (princ "\nEsc button was pressed.") (princ) ) ; error defun ;subroutines used: smallangle, elementorlist, pairvertices, clstpoint (defun smallangle ( pt1 pt2 / ang1 ang2 ) ;gets two points as input ;it returns the smallest angle between them (setq ang1 (angle pt1 pt2) ang2 (angle pt2 pt1) ) (if (< ang1 ang2) ang1 ang2 ) ;if ); defun smallangle (defun elementorlist ( pnts ) ;;; takes as argument one of the following ;;; and returns the corresponding message ;;; !! a and b must be numbers !! ;;;- a or (a)-> elmnt (single element) ;;;- (a b) -> slist (simple list) ;;;- ( (a b) (c d)) -> clist (complex list) ;;;- ( ( (a1 b1) (a2 b2) ) ( (c1 d2) (c2 d2) ) ) -> sclist (super complex list) (if (or (eq (type pnts) (READ "INT")) (eq (TYPE X) (READ "REAL")) ) ;OR (setq pnts (list pnts)) (princ) ) (cond ( (AND (eq (length pnts) 1 ) (vl-every '(lambda (x) (or (eq (TYPE X) (READ "REAL")) (eq (TYPE X) (READ "INT")) ) ) pnts) ) ;AND "elmnt" ) ( (vl-every '(lambda (x) (or (eq (TYPE X) (READ "REAL")) (eq (TYPE X) (READ "INT")) ) ;or ) pnts) "slist") ( (AND (vl-every '(lambda (x) (eq (TYPE X) (READ "list"))) pnts ) (vl-every '(lambda (x) (eq (TYPE (car X)) (READ "list") ) ) pnts ) ) ;AND "sclist" ) (T "clist") ) ;cond ) (defun clstpoint ( / ent testpoint entityy pts miin lst nearestpt a b ) ;gets as input a pline or line and pick point ;returns the vertex that is "closest" to the pick point ;"closest" in terms of defining a new X axis (setq ent (entsel "pick new x axis") entityy (entget (car ent)) testpoint (cadr ent) ) (setq testpoint (vlax-curve-getclosestpointto (vlax-ename->vla-object (car ent)) testpoint)) (if (wcmatch (cdr (assoc 0 entityy)) "LINE") (progn (setq nearestpt (list (cadr (assoc 10 entityy)) (caddr (assoc 10 entityy))) ) ) ;progn if line is selected (progn ;testpoint is now actually *on* the pline/line ;(drwpoint testpoint) -DEBUG (setq pts nil) (while (assoc 10 entityy) ;loop until there is no point (10 dxf group code) remaining (setq pts (append pts (list (cdr (assoc 10 entityy))))) (setq entityy (cdr (member (assoc 10 entityy) entityy))) (princ) ) (foreach k (pairvertices pts) (if (equal (smallangle testpoint (car k)) (smallangle testpoint (cadr k)) 0.1) ;eq (setq nearestpt (car k)) ) ;if ) ;foreach ) ;progn if pline is selected ) ; if (list testpoint nearestpt) ) (defun pairvertices ( lst / 1p ) ;accepts only clist ; make list ( (a b) (c d) (d e) ) -> ; ( ( (a b) (b c) ) ((b c) (c d) ) ( (c d) (d e) ) (if (eq (elementorlist lst) "clist" ) (progn (if (eq (length lst) 2) ;if only two points are in the vertices list, do nothing pts (progn (repeat (- (length lst) 1) (setq 1p (append 1p (list (list (nth 0 lst) (nth 1 lst))) ) ) (setq lst (cdr (member (nth 0 lst) lst))) ;read from here ) 1p ) ;progn if vertices list has more than 2 points ) ;if ) ;progn if clist is fed (progn (princ "\nWrong Input. Exiting.") (exit) ) ;progn in anything but clist is fed ) ;if ) ;;;=================================================================;;;;;; (if (eq (getvar "worlducs") ; 0 if user-defined system is enabled / 1 if wcs is active 0 ) (command-s "ucs" "World") ) ;if (initget 1 "Yes No") (setq ans (strcase (getkword "\nDefine and Move? (Yes or No) "))) (command "UNDO" "BE") ;undo from this point will undo everything (setq ortho_backup (getvar "orthomode") osmode_backup (getvar "osmode") grid_mode (getvar "gridmode") ) ;setq (setvar "orthomode" 0) (setvar "gridmode" 0) (setvar "osmode" 0) ;43 ) ; 43 osmode = endpoint, midpoint, node, intersection (setq ptslist (clstpoint) pp1 (trans (car ptslist) 0 1) pp2 (trans (cadr ptslist) 0 1) ) ;setq (command "_.ucs" "_3p" "_non" ;no object snap for next point pp1 "_non" pp2 "") ;command (if (eq ans "YES") (progn (setvar "osmode" osmode_backup) (setvar "orthomode" ortho_backup) (setvar "gridmode" grid_mode) (setvar "orthomode" 1) (setvar "osmode" 0) (if (setq ss (ssget "_:L-I")) (command "_.move" ss "" "_none" pause pause) ;command (progn ;print that no selection was made (princ "\nNo selection was made for move command. Exiting.\n" ) (princ) ) ;progn ) ;if selection is made (command "ucs" "World") );progn ) ;if move command needs to be called (command "UNDO" "END") ;undo until here acts as one thing (setvar "osmode" osmode_backup) (setvar "orthomode" ortho_backup) (setvar "gridmode" grid_mode) ) ;defun 6 // new X axis 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.