damolol Posted March 18, 2022 Posted March 18, 2022 Hi guys, I tried doing a search but couldn't seem to find anything relevant. I just need the lisp to create a single point at the centre of a square or rectangle. Thanks in advance Quote
Steven P Posted March 18, 2022 Posted March 18, 2022 I got this off this forum once, (defun c:CtrCoo (/ findctr a apt) ;;Center point of a hatch or a rectangle (defun findctr (en / pt) (command "_.Zoom" "_Object" en "") (setq pt (getvar 'viewctr)) (command "_.Zoom" "_Previous") pt ) (setq a (car (entsel "Select Rectangle: : ")) apt (findctr a)) (command "_Text" "_Justify" "_MC" apt 0.1 0 apt) (princ) ) change the last line "(command "_Text"...... " to be a point instead 1 Quote
Steven P Posted March 18, 2022 Posted March 18, 2022 and this one ill give you the point in the centre of 2 selected points (defun rectcentre ( / pt1 pt2 ptx pty ptz ptc) (setq pt1 (getpoint "\nPick Corner 1")) (setq pt2 (getpoint "\nPick Corner 2")) (setq ptx (+ (nth 0 pt1) (/ (- (nth 0 pt2)(nth 0 pt1)) 2)) ) (setq pty (+ (nth 1 pt1) (/ (- (nth 1 pt2)(nth 1 pt1)) 2)) ) (setq ptz (+ (nth 2 pt1) (/ (- (nth 2 pt2)(nth 2 pt1)) 2)) ) (setq ptc (list ptx pty ptz)) ptc ) You can use the output from this, ptc, to create a point Quote
mhupp Posted March 18, 2022 Posted March 18, 2022 Ronjonp showed/posted this one a few weeks ago. (setq pt1 (getpoint "\nPoint 1") pt2 (getpoint "\nPoint 2") mpt (mapcar '/ (mapcar '+ pt1 pt2) '(2 2 2)) ) Same as first but using polar and bounding box (vla-getboundingbox (vlax-ename->vla-object rec) 'minpt 'maxpt) ;rec = rectangle entity name. (setq LL (vlax-safearray->list minpt) UR (vlax-safearray->list maxpt) MPT (polar LL (angle LL UR) (/ (distance LL UR) 2)) ) Using geometric center snap. must be closed polyline or spline. (setq rec (vlax-ename->vla-object (car (entsel "\nSelect Rectangle")))) (setq MPT (osnap (vlax-curve-getStartPoint rec) "gcen")) 1 Quote
Trudy Posted March 18, 2022 Posted March 18, 2022 Hello, one lisp from Ronjonp for centroid. (vl-load-com) (defun c:cent ( / rgn pt objenam) ;ronjonp (setq objenam (car (entsel "\n Select polyline: "))) (if (and (setq spc (vlax-ename->vla-object (cdr (assoc 330 (entget objenam))))) (setq objenam (vlax-ename->vla-object objenam)) (= 'list (type (setq rgn (vl-catch-all-apply 'vlax-invoke (list spc 'addregion (list objenam)))))) ) (progn (setq pt (vlax-get (setq rgn (car rgn)) 'centroid)) (vl-catch-all-apply 'vla-delete (list rgn)) (entmake (list '(0 . "POINT") (cons 10 pt) '(8 . "centroid"))) ) ) (princ) ) Quote
devitg Posted March 18, 2022 Posted March 18, 2022 (edited) from my tool box (DEFUN G-MIDPOINT-OBJ (OBJECT / P1 P2) ;_01 (IF (= (TYPE OBJECT) 'ENAME) (SETQ OBJECT (VLAX-ENAME->VLA-OBJECT OBJ)) ) (VLA-GETBOUNDINGBOX OBJECT 'P1 'P2) (SETQ P1 (VLAX-SAFEARRAY->LIST P1) P2 (VLAX-SAFEARRAY->LIST P2) ) (MAPCAR '* '(0.5 0.5 0.5) (MAPCAR '+ P1 P2)) ) (defun c:mid-box (/ OBJ) (VL-LOAD-COM) (Prompt "\n Select the object") (setq obj (ssname (ssget "_:S+.") 0)) ;;; (G-MIDPOINT-OBJ) (setvar 'pdmode 34) (setvar 'pdsize 5) (entmake (list '(0 . "POINT") (cons 10 (G-MIDPOINT-OBJ obj)) ) ) ) ;_ defun ;|«Visual LISP© Format Options» (100 2 1 2 T " " 100 6 0 0 1 nil T nil T) ;*** DO NOT add text below the comment! ***|; damolol point at center.lsp Edited March 18, 2022 by devitg some error . cvorrected 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.