Leaderboard

(defun c:corner_inv_chamfer_arc ( / *error* ftoa catch_cont unit mid v^v MR:3pcircle MR:3parc cmd pea rad r p pp pl c arc1 arc2 p1 p2 p3 p4 ss s i e el ex par flag flagg k ptl ptlpairs pair n ) (vl-load-com) (defun *error* ( m ) (if command-s (command-s "_.UNDO" "_E") (vl-cmdf "_.UNDO" "_E") ) (if cmd (setvar 'cmdecho cmd) ) (if pea (setvar 'peditaccept pea) ) (if m (prompt m) ) (princ) ) (defun ftoa ( n / m a s b ) (if (numberp n) (progn (setq m (fix ((if (< n 0) - +) n 1e-8))) (setq a (abs (- n m))) (setq m (itoa m)) (setq s "") (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0)))) (setq s (strcat s (itoa b))) (setq a (- (* a 10.0) b)) ) (if (= (type n) 'int) m (if (= s "") m (if (and (= m "0") (< n 0)) (strcat "-" m "." s) (strcat m "." s) ) ) ) ) ) ) (defun catch_cont ( / catch ) (prompt "\nleft mouse click to continue or enter to generate catch error - ESC to break...") (while (and (or (not (equal (grread) '(2 13))) (not (vl-catch-all-error-p (setq catch (vl-catch-all-apply (function /) (list 1 0)))))) (/= (car (grread)) 3))) (if (vl-catch-all-error-p catch) catch ) ) (defun unit ( v / d catch ) (if (not (equal (setq d (distance (list 0.0 0.0 0.0) v)) 0.0 1e-8)) (mapcar (function (lambda ( x ) (/ x d))) v) (progn (prompt "\ncatched error in (unit) - strength of reference vector near 0.0") (if (vl-catch-all-error-p (catch_cont)) (vl-catch-all-apply (function /) (list 1 0)) ) ) ) ) (defun mid ( p1 p2 ) (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) p1 p2) ) (defun v^v ( u v ) (list (- (* (cadr u) (caddr v)) (* (caddr u) (cadr v))) (- (* (caddr u) (car v)) (* (car u) (caddr v))) (- (* (car u) (cadr v)) (* (cadr u) (car v))) ) ) ;; 3-Point Circle - M.R. ;; ;; Returns the center (WCS) and radius of the circle defined by three supplied points - all 3 points in (WCS) ;; (defun MR:3pcircle ( pt1 pt2 pt3 / cen md1 md2 vc1 vc2 ocs ci ) (if (and (setq md1 (mid pt1 pt2)) (setq md2 (mid pt2 pt3)) (setq vc1 (v^v (mapcar (function -) pt2 pt1) (setq ocs (v^v (mapcar (function -) pt3 pt1) (mapcar (function -) pt2 pt1))))) (setq vc2 (v^v (mapcar (function -) pt3 pt2) ocs)) (setq cen (inters md1 (mapcar (function +) md1 vc1) md2 (mapcar (function +) md2 vc2) nil ) ) ) (list cen (distance cen pt1)) ) ) ;; 3-Point Arc - M.R. ;; ;; Returns ARC entity in 3D space - arguments pt1, pt2, pt3 - all 3 points in (WCS) ;; (defun MR:3parc ( pt1 pt2 pt3 / lst ocs ) (if (and (setq ocs (unit (v^v (mapcar (function -) pt3 pt1) (mapcar (function -) pt2 pt1)))) (setq lst (MR:3pcircle pt1 pt2 pt3))) (progn (if (minusp (sin (- (angle (trans pt1 0 ocs) (trans pt3 0 ocs)) (angle (trans pt1 0 ocs) (trans pt2 0 ocs))))) (mapcar (function set) (list (quote pt1) (quote pt3)) (list pt3 pt1)) ) (entmakex (list (cons 0 "ARC") (cons 10 (trans (car lst) 0 ocs)) (cons 40 (cadr lst)) (cons 50 (angle (trans (car lst) 0 ocs) (trans pt1 0 ocs))) (cons 51 (angle (trans (car lst) 0 ocs) (trans pt3 0 ocs))) (cons 210 ocs) ) ) ) ) ) (setq cmd (getvar 'cmdecho)) (setvar 'cmdecho 1) (setq pea (getvar 'peditaccept)) (setvar 'peditaccept 1) (if (= 8 (logand 8 (getvar 'undoctl))) (vl-cmdf "_.UNDO" "_E") ) (vl-cmdf "_.UNDO" "_G") (setq rad (getvar 'filletrad)) (initget 6) (setq r (getdist (strcat "\nPick or specify radius of fillet <" (ftoa rad) "> : "))) (if (not r) (setq r rad) ) (setvar 'chamfera r) (setvar 'chamferb r) (prompt "\nENTER FOR PICK CURVES - 2 SEGMENTS, ELSE SELECT POLYLINES...") (if (if (ssget "_A" '((0 . "*POLYLINE"))) (not (setq ss (ssget "_:L" '((0 . "*POLYLINE"))))) t ) (progn (setq p (getvar 'lastpoint) el (entlast)) (vl-cmdf "_.CHAMFER") (while (< 0 (getvar 'cmdactive)) (vl-cmdf "\\") (if (not (equal p (setq pp (getvar 'lastpoint)) 1e-6)) (setq pl (cons pp pl)) ) ) (if (not (eq el (entlast))) (if (= (cdr (assoc 0 (setq ex (entget (entlast))))) "LINE") (progn (setq c (inters (vlax-curve-getpointatparam (setq e (car (nentselp (osnap (car pl) "_nea")))) (- (vlax-curve-getparamatpoint e (vlax-curve-getclosestpointto e (car pl))) 0.05)) (vlax-curve-getpointatparam (setq e (car (nentselp (osnap (car pl) "_nea")))) (+ (vlax-curve-getparamatpoint e (vlax-curve-getclosestpointto e (car pl))) 0.05)) (vlax-curve-getpointatparam (setq e (car (nentselp (osnap (cadr pl) "_nea")))) (- (vlax-curve-getparamatpoint e (vlax-curve-getclosestpointto e (cadr pl))) 0.05)) (vlax-curve-getpointatparam (setq e (car (nentselp (osnap (cadr pl) "_nea")))) (+ (vlax-curve-getparamatpoint e (vlax-curve-getclosestpointto e (cadr pl))) 0.05)) nil)) (setq arc1 (MR:3parc (cdr (assoc 10 ex)) (mapcar (function +) (mapcar (function *) (unit (mapcar (function -) (mid (cdr (assoc 10 ex)) (cdr (assoc 11 ex))) c)) (list r r r)) c) (cdr (assoc 11 ex)))) (setq arc2 (MR:3parc (cdr (assoc 10 ex)) (mapcar (function +) (mapcar (function *) (unit (mapcar (function -) c (mid (cdr (assoc 10 ex)) (cdr (assoc 11 ex))))) (list r r r)) c) (cdr (assoc 11 ex)))) (if (< (vla-get-arclength (vlax-ename->vla-object arc1)) (vla-get-arclength (vlax-ename->vla-object arc2))) (entdel arc1) (entdel arc2) ) (entdel (cdr (assoc -1 ex))) ) ) (if (wcmatch (cdr (assoc 0 (setq ex (entget (car (nentselp (osnap (car pl) "_nea"))))))) "*POLYLINE,VERTEX") (progn (if (wcmatch (cdr (assoc 0 ex)) "POLYLINE,VERTEX") (cond ( (= (cdr (assoc 0 ex)) "VERTEX") (setq ex (entget (cdr (assoc 330 ex)))) (vl-cmdf "_.CONVERTPOLY" "_L" (cdr (assoc -1 ex)) "") (setq ex (entget (cdr (assoc -1 ex)))) (setq flag 1) ) ( (= (cdr (assoc 0 ex)) "POLYLINE") (vl-cmdf "_.CONVERTPOLY" "_L" (cdr (assoc -1 ex)) "") (setq ex (entget (cdr (assoc -1 ex)))) (setq flag 1) ) ) ) (if (= (cdr (assoc 0 ex)) "LWPOLYLINE") (if (> (abs (fix (- (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getclosestpointto (cdr (assoc -1 ex)) (car pl))) (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getclosestpointto (cdr (assoc -1 ex)) (cadr pl)))))) 1.0) (progn (setq c (inters (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (- (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getclosestpointto (cdr (assoc -1 ex)) (car pl))) 0.05)) (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (+ (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getclosestpointto (cdr (assoc -1 ex)) (car pl))) 0.05)) (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (- (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getclosestpointto (cdr (assoc -1 ex)) (cadr pl))) 0.05)) (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (+ (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getclosestpointto (cdr (assoc -1 ex)) (cadr pl))) 0.05)) nil)) (setq arc1 (MR:3parc (vlax-curve-getstartpoint (cdr (assoc -1 ex))) (mapcar (function +) (mapcar (function *) (unit (mapcar (function -) (mid (vlax-curve-getstartpoint (cdr (assoc -1 ex))) (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (1- (vlax-curve-getendparam (cdr (assoc -1 ex)))))) c)) (list r r r)) c) (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (1- (vlax-curve-getendparam (cdr (assoc -1 ex))))))) (setq arc2 (MR:3parc (vlax-curve-getstartpoint (cdr (assoc -1 ex))) (mapcar (function +) (mapcar (function *) (unit (mapcar (function -) c (mid (vlax-curve-getstartpoint (cdr (assoc -1 ex))) (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (1- (vlax-curve-getendparam (cdr (assoc -1 ex)))))))) (list r r r)) c) (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (1- (vlax-curve-getendparam (cdr (assoc -1 ex))))))) (if (< (vla-get-arclength (vlax-ename->vla-object arc1)) (vla-get-arclength (vlax-ename->vla-object arc2))) (entdel arc1) (entdel arc2) ) (entupd (cdr (assoc -1 (entmod (subst (cons 70 (* 128 (getvar 'plinegen))) (assoc 70 ex) ex))))) (setq s (ssadd)) (cond ( (not (vlax-erased-p arc1)) (ssadd arc1 s) ) ( (not (vlax-erased-p arc2)) (ssadd arc2 s) ) ) (ssadd (cdr (assoc -1 ex)) s) ;| (vl-cmdf "_.PEDIT" "_M" s "" "_J") (while (< 0 (getvar 'cmdactive)) (vl-cmdf "") ) |; ;;; for AutoCAD (vl-cmdf "_.JOIN" s "") ;;; for BricsCAD ) (progn (setq par (- (max (fix (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getclosestpointto (cdr (assoc -1 ex)) (car pl)))) (fix (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getclosestpointto (cdr (assoc -1 ex)) (cadr pl))))) 0.5)) (setq p1 (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (- par 0.5)) p2 (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (+ par 0.5))) (setq c (inters (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (- (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getclosestpointto (cdr (assoc -1 ex)) (car pl))) 0.05)) (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (+ (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getclosestpointto (cdr (assoc -1 ex)) (car pl))) 0.05)) (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (- (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getclosestpointto (cdr (assoc -1 ex)) (cadr pl))) 0.05)) (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (+ (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getclosestpointto (cdr (assoc -1 ex)) (cadr pl))) 0.05)) nil)) (setq arc1 (MR:3parc p1 (mapcar (function +) (mapcar (function *) (unit (mapcar (function -) (mid p1 p2) c)) (list r r r)) c) p2)) (setq arc2 (MR:3parc p1 (mapcar (function +) (mapcar (function *) (unit (mapcar (function -) c (mid p1 p2))) (list r r r)) c) p2)) (if (< (vla-get-arclength (vlax-ename->vla-object arc1)) (vla-get-arclength (vlax-ename->vla-object arc2))) (entdel arc1) (entdel arc2) ) (vl-cmdf "_.BREAK" (cdr (assoc -1 ex)) "" "_non" (trans p1 0 1) "_non" (trans p2 0 1)) (setq s (ssadd)) (cond ( (not (vlax-erased-p arc1)) (ssadd arc1 s) ) ( (not (vlax-erased-p arc2)) (ssadd arc2 s) ) ) (ssadd (car (nentselp (osnap (cadr pl) "_nea"))) s) (ssadd (car (nentselp (osnap (car pl) "_nea"))) s) ;| (vl-cmdf "_.PEDIT" "_M" s "" "_J") (while (< 0 (getvar 'cmdactive)) (vl-cmdf "") ) |; ;;; for AutoCAD (vl-cmdf "_.JOIN" s "") ;;; for BricsCAD ) ) ) (if flag (vl-cmdf "_.CONVERTPOLY" "_H" (cdr (assoc -1 ex)) "") ) ) ) ) ) (if ss (repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i)))) (setq ex (entget e)) (if (wcmatch (cdr (assoc 0 ex)) "POLYLINE,VERTEX") (cond ( (= (cdr (assoc 0 ex)) "VERTEX") (setq ex (entget (cdr (assoc 330 ex)))) (vl-cmdf "_.CONVERTPOLY" "_L" (cdr (assoc -1 ex)) "") (setq ex (entget (cdr (assoc -1 ex)))) (setq flag 1) ) ( (= (cdr (assoc 0 ex)) "POLYLINE") (vl-cmdf "_.CONVERTPOLY" "_L" (cdr (assoc -1 ex)) "") (setq ex (entget (cdr (assoc -1 ex)))) (setq flag 1) ) ) ) (if (= 1 (logand 1 (cdr (assoc 70 (setq ex (entget e)))))) (progn (setq ptl (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) ex))) (setq ptlpairs (mapcar (function (lambda ( a b ) (list a b))) ptl (append (cdr ptl) (list (car ptl))))) (setq pair (car (vl-sort ptlpairs (function (lambda ( a b ) (> (distance (car a) (cadr a)) (distance (car b) (cadr b)))))))) (setq flagg 1) (vl-cmdf "_.BREAK" e "" "_non" (trans (polar (mid (vlax-curve-getpointatparam e (float (fix (+ 0.1 (vlax-curve-getparamatpoint e (trans (append (car pair) (list (cdr (assoc 38 ex)))) e 0)))))) (vlax-curve-getpointatparam e (float (fix (+ 0.1 (vlax-curve-getparamatpoint e (trans (append (cadr pair) (list (cdr (assoc 38 ex)))) e 0))))))) (angle (vlax-curve-getpointatparam e (float (fix (+ 0.1 (vlax-curve-getparamatpoint e (trans (append (car pair) (list (cdr (assoc 38 ex)))) e 0)))))) (vlax-curve-getpointatparam e (float (fix (+ 0.1 (vlax-curve-getparamatpoint e (trans (append (cadr pair) (list (cdr (assoc 38 ex)))) e 0))))))) 0.05) 0 1) "_non" (trans (polar (mid (vlax-curve-getpointatparam e (float (fix (+ 0.1 (vlax-curve-getparamatpoint e (trans (append (car pair) (list (cdr (assoc 38 ex)))) e 0)))))) (vlax-curve-getpointatparam e (float (fix (+ 0.1 (vlax-curve-getparamatpoint e (trans (append (cadr pair) (list (cdr (assoc 38 ex)))) e 0))))))) (angle (vlax-curve-getpointatparam e (float (fix (+ 0.1 (vlax-curve-getparamatpoint e (trans (append (car pair) (list (cdr (assoc 38 ex)))) e 0)))))) (vlax-curve-getpointatparam e (float (fix (+ 0.1 (vlax-curve-getparamatpoint e (trans (append (cadr pair) (list (cdr (assoc 38 ex)))) e 0))))))) -0.05) 0 1)) ) ) (vl-cmdf "_.CHAMFER" "_P" e) (while (< 0 (getvar 'cmdactive)) (vl-cmdf "") ) (setq ex (entget e)) (repeat (fix (/ (+ 0.1 (setq n (1- (vlax-curve-getendparam (cdr (assoc -1 ex)))))) 2.0)) (setq par (+ (setq n (- n 2.0)) 1.5)) (setq p1 (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (rem (- par 0.5) (fix (+ 0.1 (vlax-curve-getendparam (cdr (assoc -1 ex))))))) p2 (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (rem (+ par 0.5) (fix (+ 0.1 (vlax-curve-getendparam (cdr (assoc -1 ex)))))))) (setq c (inters (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (- (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (float (rem (1- par) (fix (+ 0.1 (vlax-curve-getendparam (cdr (assoc -1 ex))))))))) 0.05)) (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (+ (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (float (rem (1- par) (fix (+ 0.1 (vlax-curve-getendparam (cdr (assoc -1 ex))))))))) 0.05)) (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (- (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (float (rem (1+ par) (fix (+ 0.1 (vlax-curve-getendparam (cdr (assoc -1 ex))))))))) 0.05)) (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (+ (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (float (rem (1+ par) (fix (+ 0.1 (vlax-curve-getendparam (cdr (assoc -1 ex))))))))) 0.05)) nil)) (setq arc1 (MR:3parc p1 (mapcar (function +) (mapcar (function *) (unit (mapcar (function -) (mid p1 p2) c)) (list r r r)) c) p2)) (setq arc2 (MR:3parc p1 (mapcar (function +) (mapcar (function *) (unit (mapcar (function -) c (mid p1 p2))) (list r r r)) c) p2)) (if (< (vla-get-arclength (vlax-ename->vla-object arc1)) (vla-get-arclength (vlax-ename->vla-object arc2))) (entdel arc1) (entdel arc2) ) (setq p3 (trans (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (float (rem (1- par) (fix (+ 0.1 (vlax-curve-getendparam (cdr (assoc -1 ex)))))))) 0 1) p4 (trans (vlax-curve-getpointatparam (cdr (assoc -1 ex)) (float (rem (1+ par) (fix (+ 0.1 (vlax-curve-getendparam (cdr (assoc -1 ex)))))))) 0 1)) (vl-cmdf "_.BREAK" (cdr (assoc -1 ex)) "" "_non" (trans p1 0 1) "_non" (trans p2 0 1)) (setq s (ssadd)) (cond ( (not (vlax-erased-p arc1)) (ssadd arc1 s) ) ( (not (vlax-erased-p arc2)) (ssadd arc2 s) ) ) (ssadd (car (nentselp p3)) s) (ssadd (car (nentselp p4)) s) ;| (vl-cmdf "_.PEDIT" "_M" s "" "_J") (while (< 0 (getvar 'cmdactive)) (vl-cmdf "") ) |; ;;; for AutoCAD (vl-cmdf "_.JOIN" s "") ;;; for BricsCAD ) (if flagg (progn ;| (if (not (eq (cdr (assoc -1 ex)) (entlast))) (setq ex (entget (entlast))) ) (setq n (fix (+ 0.1 (vlax-curve-getendparam (cdr (assoc -1 ex)))))) (setq ex (mapcar (function (lambda ( x ) (if (= (car x) 10) (progn (setq k (if (not k) 0 (1+ k))) (if (or (= k 0) (= k n)) 1 x)) x))) ex)) (setq k nil) (setq ex (append (reverse (cdr (member 1 (cdr (member 1 (reverse ex)))))) (member (assoc 10 (cdr (member 1 ex))) (reverse (cdr (member 1 (reverse ex))))) (cdr (member 1 (cdr (member 1 ex)))))) (setq ex (subst (cons 90 (1- n)) (assoc 90 ex) ex)) (setq ex (subst (cons 70 (1+ (* 128 (getvar 'plinegen)))) (assoc 70 ex) ex)) (entupd (cdr (assoc -1 (entmod ex)))) |; ; something's wrong with this version - try to debug if you want ; (vl-cmdf "_.TRIM" "_L" "" "_non" (trans (vlax-curve-getstartpoint (entlast)) 0 1) "_non" (trans (vlax-curve-getendpoint (entlast)) 0 1) "") (vla-put-closed (vlax-ename->vla-object (entlast)) :vlax-true) ) ) (if flag (vl-cmdf "_.CONVERTPOLY" "_H" (cdr (assoc -1 ex)) "") ) (setq flag nil flagg nil) ) ) ) (*error* nil) )

Hmm click on image in Acad then CTRL+c, you can then paste in current acad or another dwg, pasting to excel is a different matter. The best for pasting to Word I found to be create a WMF this can be image and linework on top gives a very good result.

Select a Dimension then Shift+Right-Click → Select Dim Style → pick an option.

I tested those coordinates against my master drawing and they pinpoint exactly the center of the cul-de-sac on SW 85th Ave.

i don't have enough time to see that. but this will make it linked image to inside attached image. in excel about 1 workbook all sheets all images Sub attachlinkedimage() On Error Resume Next Dim shtNo As Integer Dim i As Integer Dim j As Integer Dim wks As Worksheet Dim shpC As Shape Dim picLeft As Single Dim picTop As Single Application.ScreenUpdating = False shtNo = ActiveSheet.Index For i = 1 To Sheets.Count Sheets(i).Activate For Each shpC In Sheets(i).Shapes If shpC.Type = 11 Then picLeft = shpC.Left picTop = shpC.Top shpC.Cut ActiveSheet.PasteSpecial Format:="Picture (PNG)", Link:=False, DisplayAsIcon:=False Selection.Left = picLeft Selection.Top = picTop MsgBox j & "th image converted ok" j = j + 1 End If Next shpC Next i MsgBox "Complete" Sheets(shtNo).Activate End Sub alt+f11 and add module and paste it and run that macro in alt+f8 + The "Pictures (PNG)" part of this code is affected by the language setting of Excel. Actually "Pictures (PNG)" doesn't work in my language. I can't prepare for all languages, so to apply this to excel in other languages 1. Turn on macro recording. 2. ctrl+c the image, ctrl+shift+v, select the png format and paste it. 3. Stop recording the macro and 4. In the code view at alt+f11, check which word is included in this part. 5. Replace this code with that word.

osmode 0 should fix works in 99% of cases. Maybe a zoom C scale around line picked so see on screen at reasonable scale. I have been doing stuff replace 1000 blocks, new text, new leader in a dwg so zoom e 1st and no problems. Bricscad and Acad. Watch the fly spec appear.

(defun c:inv_fillet ( / *error* ftoa cmd rad r p pp pl ss i e el ex par flag k ) (vl-load-com) (defun *error* ( m ) (if command-s (command-s "_.UNDO" "_E") (vl-cmdf "_.UNDO" "_E") ) (if cmd (setvar 'cmdecho cmd) ) (if m (prompt m) ) (princ) ) (defun ftoa ( n / m a s b ) (if (numberp n) (progn (setq m (fix ((if (< n 0) - +) n 1e-8))) (setq a (abs (- n m))) (setq m (itoa m)) (setq s "") (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0)))) (setq s (strcat s (itoa b))) (setq a (- (* a 10.0) b)) ) (if (= (type n) 'int) m (if (= s "") m (if (and (= m "0") (< n 0)) (strcat "-" m "." s) (strcat m "." s) ) ) ) ) ) ) (setq cmd (getvar 'cmdecho)) (setvar 'cmdecho 1) (if (= 8 (logand 8 (getvar 'undoctl))) (vl-cmdf "_.UNDO" "_E") ) (vl-cmdf "_.UNDO" "_G") (setq rad (getvar 'filletrad)) (initget 6) (setq r (getdist (strcat "\nPick or specify radius of fillet <" (ftoa rad) "> : "))) (if (not r) (setq r rad) ) (setvar 'filletrad r) (prompt "\nENTER FOR PICK CURVES - 2 SEGMENTS, ELSE SELECT POLYLINES...") (if (if (ssget "_A" '((0 . "*POLYLINE"))) (not (setq ss (ssget "_:L" '((0 . "*POLYLINE"))))) t ) (progn (setq p (getvar 'lastpoint) el (entlast)) (vl-cmdf "_.FILLET") (while (< 0 (getvar 'cmdactive)) (vl-cmdf "\\") (if (not (equal p (setq pp (getvar 'lastpoint)) 1e-6)) (setq pl (cons pp pl)) ) ) (if (not (eq el (entlast))) (if (= (cdr (assoc 0 (setq ex (entget (entlast))))) "ARC") (entupd (cdr (assoc -1 (entmod (mapcar (function (lambda ( x ) (cond ( (= (car x) 50) (cons 50 (cdr (assoc 51 ex))) ) ( (= (car x) 51) (cons 51 (cdr (assoc 50 ex))) ) ( t x )))) ex))))) ) (if (wcmatch (cdr (assoc 0 (setq ex (entget (car (nentselp (osnap (car pl) "_nea"))))))) "*POLYLINE,VERTEX") (progn (if (wcmatch (cdr (assoc 0 ex)) "POLYLINE,VERTEX") (cond ( (= (cdr (assoc 0 ex)) "VERTEX") (setq ex (entget (cdr (assoc 330 ex)))) (vl-cmdf "_.CONVERTPOLY" "_L" (cdr (assoc -1 ex)) "") (setq ex (entget (cdr (assoc -1 ex)))) (setq flag t) ) ( (= (cdr (assoc 0 ex)) "POLYLINE") (vl-cmdf "_.CONVERTPOLY" "_L" (cdr (assoc -1 ex)) "") (setq ex (entget (cdr (assoc -1 ex)))) (setq flag t) ) ) ) (if (= (cdr (assoc 0 ex)) "LWPOLYLINE") (if (> (abs (fix (- (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getclosestpointto (cdr (assoc -1 ex)) (car pl))) (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getclosestpointto (cdr (assoc -1 ex)) (cadr pl)))))) 1.0) (if (= (cdr (assoc 42 ex)) 0.0) (entupd (cdr (assoc -1 (entmod (subst (cons 42 (- (/ 1.0 (cdr (assoc 42 (reverse ex)))))) (assoc 42 (reverse ex)) ex))))) (entupd (cdr (assoc -1 (entmod (subst (cons 42 (- (/ 1.0 (cdr (assoc 42 ex))))) (assoc 42 ex) ex))))) ) (progn (setq par (/ (+ (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getclosestpointto (cdr (assoc -1 ex)) (car pl))) (vlax-curve-getparamatpoint (cdr (assoc -1 ex)) (vlax-curve-getclosestpointto (cdr (assoc -1 ex)) (cadr pl)))) 2.0)) (entupd (cdr (assoc -1 (entmod (mapcar (function (lambda ( x ) (if (= (car x) 42) (progn (setq k (if (not k) 0 (1+ k))) (if (= k (fix par)) (if (/= (cdr x) 0.0) (cons 42 (- (/ 1.0 (cdr x)))) (cons 42 0.0)) x)) x))) ex))))) ) ) ) (if flag (vl-cmdf "_.CONVERTPOLY" "_H" (cdr (assoc -1 ex)) "") ) ) ) ) ) (if ss (repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i)))) (vl-cmdf "_.FILLET" "_P" e) (while (< 0 (getvar 'cmdactive)) (vl-cmdf "") ) (setq ex (entget e)) (if (wcmatch (cdr (assoc 0 ex)) "POLYLINE,VERTEX") (cond ( (= (cdr (assoc 0 ex)) "VERTEX") (setq ex (entget (cdr (assoc 330 ex)))) (vl-cmdf "_.CONVERTPOLY" "_L" (cdr (assoc -1 ex)) "") (setq ex (entget (cdr (assoc -1 ex)))) (setq flag t) ) ( (= (cdr (assoc 0 ex)) "POLYLINE") (vl-cmdf "_.CONVERTPOLY" "_L" (cdr (assoc -1 ex)) "") (setq ex (entget (cdr (assoc -1 ex)))) (setq flag t) ) ) ) (if (= (cdr (assoc 0 ex)) "LWPOLYLINE") (entupd (cdr (assoc -1 (entmod (mapcar (function (lambda ( x ) (if (and (= (car x) 42) (/= (cdr x) 0.0)) (cons 42 (- (/ 1.0 (cdr x)))) x))) ex))))) ) (if flag (vl-cmdf "_.CONVERTPOLY" "_H" (cdr (assoc -1 ex)) "") ) (setq flag nil) ) ) ) (*error* nil) )

Just to simplify code - make it more concise... (defun c:dataext_door_winddow_cabinet ( / process ) (defun process ( tag / ss ) (cond ( (setq ss (ssget "_I" (list (cons 0 "INSERT") (cons 2 (strcat (strcase tag) " TAG"))))) (sssetfirst nil ss) ) ( (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat (strcase tag) " TAG"))))) (sssetfirst nil ss) ) ) (vl-cmdf "_.-DATAEXTRACTION" (strcat (getvar 'dwgprefix) (strcat tag " Schedule.dxe"))) (if (wcmatch (getvar 'cmdnames) "*DATAEXTRACTION*") (vl-cmdf "_Y") ) ) (process "Door") (process "Window") (process "Cabinet") (princ) )

That's my mistake. In order to prevent a lot of unnecessary image files from being created, I used the method of replacing the image file names with one. Since the timing of saving the image in Excel is the timing of saving the workbook, the files referenced by the same name before that time become as if the file does not exist. Therefore, at the beginning of all the code If you fix this line ph (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".wmf") ;edited line like this, ph (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) "-" (rtos (getvar 'cdate) 2 10) ".wmf") ;edited line there should be no problem. Unless you shoot twice in 0.0001 second. i edited original post

I know that TEXT is the only way to use HTML files. If that were possible, the problem in this link would not have been turned around like this. In MS WORD, there is a button to capture the screen in the SCREENSHOT menu. move that button to outside of ribbon menu and then putting MS WORD next to the CAD window it will be easier to use it. i think

Here's another, from my library: ;; Arc Endpoints - Lee Mac ;; Returns the endpoints of an Arc expressed in WCS (defun LM:ArcEndpoints ( ent / cen nrm rad ) (setq ent (entget ent) nrm (cdr (assoc 210 ent)) cen (cdr (assoc 010 ent)) rad (cdr (assoc 040 ent)) ) (mapcar (function (lambda ( ang ) (trans (mapcar '+ cen (list (* rad (cos ang)) (* rad (sin ang)) 0.0)) nrm 0) ) ) (list (cdr (assoc 50 ent)) (cdr (assoc 51 ent))) ) )

Could add a zoom to obj and back out to make sure it works. But would kinda flicker the screen and add a little time to the lisp.

Ahh, just checking, yes, it appears to paste in Word as an OLE, double click and it opens the image back in CAD

These work if you're using Windows Press Windows logo key + Shift + S. The desktop will darken while you select an area for your screenshot. Press PrtScn to copy the entire screen to the clipboard or press Alt + PrtScn to copy the active window to the clipboard. Clipboard in Windows Not sure what you're trying to do but for creating PNG images for AutoCAD macros I usually use PNGOUT.

Try (cons 10 p2) - without the brackets ( brackets means that what is enclosed is a function, so when you are dong the entmake it will look for the function 'p2' which doesn't exist.. and so will all go wrng)

Worth a shot.