Leaderboard

leonucadomi I edited the previous post to insert an *error* function, this resolves if the command is interrupted.

I changed it a bit. I use (vla-move instead of (vlax-invoke e 'move I hope you don't mind. I'm not sure which you want, foo puts the point 1 unit up vertically foo2 puts the point 1 unit offset to the imaginary line p1-p2 I think you want foo2. Anyway, here's both. change the bottom line if needed to (c:foo2) ;; Ronjonp - 03.22.2018 mid pt of two pts (defun _mid (p1 p2) (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.))) ; modified by Alan H basicly supports any object that can have a bounding box 03.23.2018 ;; raise a point by a certain amount, vertically (defun raise (p1 by / ) (list (nth 0 p1) (+ (nth 1 p1) by) ) ) ;; raise a point by a certain amount, vertically (defun offset_by (p1 ang by / ) (polar p1 (+ ang (/ pi 2.0)) by) ;; angle of p1-p2 + 90° ) (defun c:foo (/ e e_ p p1 p2 p3) (setq e (vlax-ename->vla-object (car (entsel "pick object")))) (vla-getboundingbox e 'll 'ur) (setq p (mapcar 'vlax-safearray->list (list ll ur))) (setq p1 (getpoint "pick 1st point")) (setq p2 (getpoint "pick 2nd point")) (setq p3(_mid p1 p2) ) ;; raise it by 1 unit (setq p3 (raise p3 1.0)) (vla-move e (vlax-3d-point (_mid (car p) (cadr p))) (vlax-3d-point p3)) (princ) ) (defun c:foo2 (/ e e_ p p1 p2 p3) (setq e (vlax-ename->vla-object (car (entsel "pick object")))) (vla-getboundingbox e 'll 'ur) (setq p (mapcar 'vlax-safearray->list (list ll ur))) (setq p1 (getpoint "pick 1st point")) (setq p2 (getpoint "pick 2nd point")) (setq p3(_mid p1 p2) ) ;; offset it by 1 unit (setq p3 (offset_by p3 (angle p1 p2) 1.0)) (vla-move e (vlax-3d-point (_mid (car p) (cadr p))) (vlax-3d-point p3)) (princ) ) (vl-load-com) (c:foo)

FWIW .. using the built in *error* function is a bit simpler like so ( also don't forget to localize it (defun c:elp (/ *error* ... ) (defun c:elp (/ *error* deriv ent ent-sel js obj_curv old_orth old_osmd old_snp param pt_sel pt_tmp p_from p_to) (defun *error* (msg) (and old_osmd (setvar "osmode" old_osmd)) (and old_orth (setvar "orthomode" old_orth)) (and old_snp (setvar "snapang" old_snp)) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\nError: " msg)) ) (princ) ) (princ "\nRaise a perpendicular to: ") (while (not (setq js (ssget "_+.:E:S" '((0 . "*LINE,ARC,CIRCLE,ELLIPSE,RAY")))))) (setq ent-sel (ssnamex js 0) ent (cadar ent-sel) pt_sel (cadar (cdddar ent-sel)) obj_curv (vlax-ename->vla-object ent) ) (cond ((member (vlax-get-property obj_curv 'objectname) '("AcDbPolyline" "AcDb2dPolyline" "AcDbLine" "AcDbArc" "AcDbCircle" "AcDbEllipse" "AcDbSpline" "AcDbRay" "AcDbXline" ) ) (setq old_osmd (getvar "osmode") old_snp (getvar "snapang") old_orth (getvar "orthomode") pt_sel (vlax-curve-getclosestpointto obj_curv pt_sel) param (vlax-curve-getparamatpoint obj_curv pt_sel) deriv (vlax-curve-getfirstderiv obj_curv param) ) (setq pt_tmp (polar pt_sel (+ (atan (cadr deriv) (car deriv)) (/ pi 2)) 100.0)) (setvar "snapang" (angle (trans pt_sel 0 1) (trans pt_tmp 0 1))) (setvar "orthomode" 1) (if (null (setq p_from (getpoint "\nFrom point <lastpoint>: "))) (setq p_from (trans pt_sel 0 1)) ) (setvar "osmode" 0) (initget 9) (setq p_to (getpoint p_from "\nTo point : ")) (command "_.line" p_from p_to "") (setvar "osmode" old_osmd) (setvar "orthomode" old_orth) (setvar "snapang" old_snp) ) (t (princ "\nInvalid object!")) ) (princ) ) (vl-load-com)

I was so busy at work so sorry for the late reply. I thought it could not be done. But wow, you've nailed it, Emmanuel! It's exactly what I was hoping for. Thank you Emmanuel!

Maybe run audit and purge on drawings? (defun c:PurgeALL () (repeat 3 (command "-Purge" "a" "" "n") ) (command "_.Audit" "y") (princ) )

Use (1) when posting code.