Leaderboard

That's because document controllers (In my opinion) are idiots and cannot see that the future is to convert everything to DWGs. for us (with the idiots in charge), the first project profits would pay to convert a whole drawing rather than each project as and when a part of the TIFF needs changing.

For single entity selection only: (defun c:test ( / MyEnt ) (while (setq MyEnt (car (entsel "\nSelect entity to delete"))) (command "erase" MyEnt "") ) ; end while (princ "OK") (princ) ) For multiple entity selections: (defun c:test ( / MyEnt ) (princ "\nSelect entity to delete") (while (setq MyEnt (ssget)) (command "erase" MyEnt "") ) ; end while (princ "OK") (princ) ) I also prefer to just press the Delete key on my keyboard.

Don't get me started on non-CAD people calling the shots on CAD. It's a dark place! So I was looking to avoid Express Tools so I came up with this version and a new thought, why the need for old file path, it's in the drawing already. I am sure this could be made better. See if this works... ;;; Update image paths in a folder of drawings. | ;;; | ;;; https://www.cadtutor.net/forum/topic/90022-change-image-path-in-many-drawings/?do=findComment&comment=650179 | ;;; | ;;; By SLW210 (Steve Wilson) | ;;;________________________________________________________________________________________________________________________________________| ;;; | ;;; Original- August 26th, 2024 | ;;; | ;;; V1.0- August 27th, 2024 Select files and folders added. | ;;; | ;;; V1.1- August 29th, 2024 Select files and folders added without Express Tools and no need to select old path. | ;;; | ;;;________________________________________________________________________________________________________________________________________| ;;; | (defun c:UPP () (c:UpYourPath)) ; You can change the shortcut to suit what is convenient for you. (defun c:UpYourPath (/ new-path folder dwg-files dwg-path old-path new-path-file new-path-ext) (vl-load-com) ;; Function to get a list of DWG files from a folder (defun get-dwg-files (folder) (vl-directory-files folder "*.dwg" 1) ) ;; Function to update image path in a drawing (defun update-dwg (dwg-path old-path new-path) (princ (strcat "\nProcessing: " dwg-path)) (setq doc (vla-open (vla-get-documents (vlax-get-acad-object)) dwg-path)) (vla-startundomark doc) ;; Update paths in Model Space (setq model-space (vla-get-ModelSpace doc)) (update-entity-paths model-space old-path new-path) ;; Update paths in Layouts (vlax-for layout (vla-get-Layouts doc) (setq paper-space (vla-get-Block layout)) (update-entity-paths paper-space old-path new-path) ) (vla-endundomark doc) (vla-save doc) (vla-close doc) ) ;; Function to update image paths in entities (defun update-entity-paths (space old-path new-path) (vlax-for ent space (if (and (vlax-property-available-p ent 'ObjectName) (= "IMAGE" (vla-get-ObjectName ent)) (vlax-property-available-p ent 'Path) (wcmatch (vla-get-Path ent) old-path)) (progn (princ (strcat "\nUpdating image path: " (vla-get-Path ent))) (vla-put-Path ent new-path) ) ) ) ) ;; Prompt user to select the new image file path (setq new-path (getfiled "Select New Image File" "" "TIFF;JPEG;PNG;BMP;GIF;" 10) ; You can add more image extensions be sure to place ; between. (if (not new-path) (progn (princ "\nNo image file selected.") (exit) ) ) ;; Extract the new image file path details (setq new-path-file (vl-filename-base new-path)) (setq new-path-ext (vl-filename-extension new-path)) (setq new-path-dir (vl-filename-directory new-path)) ;; Prompt user to select a DWG file to determine the folder path (setq sample-dwg (getfiled "Select Any DWG File in Target Folder" "" "dwg" 10)) (if (not sample-dwg) (progn (princ "\nNo DWG file selected.") (exit) ) ) ;; Extract the folder path from the selected DWG file (setq folder (vl-filename-directory sample-dwg)) ;; Get the list of DWG files in the selected folder (setq dwg-files (get-dwg-files folder)) (if (null dwg-files) (progn (princ "\nNo DWG files found in the selected folder.") (exit) ) ) ;; Construct the old path to match the new file name (setq old-path (strcat new-path-dir "\\" new-path-file new-path-ext)) ;; Update image paths in each DWG file (foreach dwg dwg-files (setq dwg-path (strcat folder "\\" dwg)) (update-dwg dwg-path old-path new-path) ) (princ "\nImage paths updated successfully.") (princ) )

Is this LISP related? Look here... Error about AEC objects when opening a drawing in AutoCAD (autodesk.com)

Sounds like dwg was made in a newer version than 2013 then your trying to open it. Probably proxy objects. May be no way to get around other than removing those objects but that may be lose objects.

; have to press the space bar after each selection. (defun c:E ( / ss ) (while (= 1 1) (if (setq ss (ssget "_:L")) (command "_.erase" ss ""))) (princ) ) ; Once selected, it will be deleted immediately. ; But this can't modify the selection set. (defun c:EE ( / ss ) (while (= 1 1) (if (setq ss (ssget "_:S:L")) (command "_.erase" ss ""))) (princ) ) I prefer to just press the Delete key on my keyboard.

You are right, I only queried the block definition. If the block is inserted at least once, the first insertion will be queried and the height will be multiplied by the scale factor in Y else the value 0.0 is returned. Will this fit? (defun c:testing ( / txtht) (mapcar '(lambda (x / tbl ent ss scal_y) (cond ((setq tbl (tblobjname "BLOCK" x)) (setq ent (entget tbl)) (while (setq ent (entnext (cdar ent))) (setq ent (entget ent)) (if (and (eq (cdr (assoc 0 ent)) "TEXT") (eq (cdr (assoc 1 ent)) "REVISIONS")) (setq txtht (cdr (assoc 40 ent))) ) ) (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 x)))) (cond (ss (setq scal_y (cdr (assoc 42 (entget (ssname ss 0)))) txtht (* txtht scal_y) ) ) (T (setq txtht 0.0)) ) ) ) ) '("FSTITLE" "VTITLE" "BEHLEN_CVR" "LOGO") ) (print txtht) (prin1) )

once made (and posted) this one for fun. Use function (c:t2) : select folder , app searches *.* and displays them in listbox. With out clicking on anything start typing letters and numbers that should be part of filename. The more you type , the smaller the list becomes. When list is small enough press ok and all files in listbox will be openend. So make sure your list box doesn't still contain 100 drawings because it will try to open every single one of them and app is very hard to kill (use ctr-alt-del) ;;; DIP - Dynamic Input , Rlx Sep'23 ;;; sort of (grread) for dcl with exception for space, tab & enter which are reserved by dcl ;;; haven't (yet) found a way to catch character for space. ;;; So gonna use ' (quote) for space, not ideal but it is what it is (vl-load-com) (defun dip ( %lst / dip-list dip-width key-lst imb-str capslock bksp bksl qmrk eb-txt f p d r ib dialog-list drv lb-sel return-list) (setq dip-list %lst) ;;; make sure all elements are strings (setq dip-list (mapcar 'vl-princ-to-string dip-list)) ;;; find length of longest member (setq dip-width (car (vl-sort (mapcar 'strlen dip-list) '>))) ;;; create key codes (setq key-lst (vl-remove-if '(lambda (x)(member x '(34 92))) (append (gnum 33 95) (gnum 123 125)))) (setq imb-str ":image_button {color=dialog_background;width=0.1;height=0.1;fixed_height=true;key=\"ib_") ;;; see if acet-sys-keystate function is available (setq capslock (member 'acet-sys-keystate (atoms-family 0)) eb-txt "" bksp (strcat ":image_button {color=dialog_background;width=0.1;height=0.1;" "fixed_height=true;key=\"ib_bksp\";label=\"&\010\";}") bksl (strcat ":image_button {mnemonic=\"\\\\\";color=dialog_background;width=0.1;" "height=0.1;fixed_height=true;key=\"ib_bksl\";label=\"&\\\\\";}") qmrk (strcat ":image_button {mnemonic=\"\\\"\";color=dialog_background;width=0.1;" "height=0.1;fixed_height=true;key=\"ib_qmrk\";label=\"&\\\"\";}") ) (and (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (mapcar '(lambda (x) (write-line x p)) (append (list "dip:dialog {label=\"DIP - Dynamic Input (Rlx Sep'23)\";:row {alignment=centered;") (crim) (list bksp bksl qmrk "}") (list ":image_button {color=141;height=1;fixed_height=true;key=\"ib_ib\";}" ":text_part {key=\"tp\";height=1;width=40;}" ) (list (strcat ":list_box {height=25;width=" (itoa (fix (* dip-width 0.9))) ";key=\"lb\";multiple_select=true;}") "ok_cancel;" "}") ) ) (not (setq p (close p))) (< 0 (setq d (load_dialog f))) (new_dialog "dip" d) (progn (upd_lbox) (action_tile "ib_bksp" "(upd_txtp $key)") (action_tile "ib_bksl" "(upd_txtp $key)") (action_tile "ib_qmrk" "(upd_txtp $key)") (stim) (action_tile "lb" "(setq lb-sel $value)") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq drv (start_dialog)) (unload_dialog d) (vl-file-delete f) ) ) (cond ((= drv 0)) ((= drv 1) (cond ((and (boundp lb-sel) (vl-consp dialog-list)) (setq return-list (mapcar '(lambda (x)(nth (atoi x) dialog-list)) (SplitStr lb-sel "")))) ((vl-consp dialog-list) (setq return-list dialog-list)) (t (setq return-list nil)) ) ) (t (setq return-list nil)) ) return-list ) ;;; create image_buttons : (setq lst (gimb)) (defun crim () (mapcar '(lambda (x)(strcat imb-str (chr x) "\";label=\"&" (chr x) "\";}")) key-lst)) ;;; start image_buttons (defun stim () (foreach x key-lst (action_tile (strcat "ib_" (chr x)) "(upd_txtp $key)"))) ;;; update edit_box , k = key (ib_$) (defun upd_txtp ( k / s l) (cond ;;; backspace ((and (eq k "ib_bksp") (> (setq l (strlen eb-txt)) 1)) (setq eb-txt (substr eb-txt 1 (1- l)))) ;;; backslash ((eq k "ib_bksl") (setq eb-txt (strcat eb-txt "\\"))) ;;; quotation mark ((eq k "ib_qmrk") (setq eb-txt (strcat eb-txt "\""))) ;;; use ' for space ((eq k "ib_'") (setq eb-txt (strcat eb-txt " "))) (t (setq eb-txt (strcat eb-txt (case (substr k 4))))) ) (if (wcmatch (strcase eb-txt t) "*bksp")(setq eb-txt "")) (start_image "ib_ib") (fill_image 0 0 (dimx_tile "ib_ib") (dimy_tile "ib_ib") 141) (end_image) (set_tile "ib_ib" eb-txt) (mode_tile k 2) (upd_lbox) ) (defun upd_lbox ( / filter) (if (not (vl-consp dip-list)) (setq dip-list '("void"))) (cond ((= eb-txt "") (setq dialog-list dip-list)) (t (setq filter (strcat "*" eb-txt "*")) (setq dialog-list (vl-remove-if-not '(lambda (x)(wcmatch (strcase x) (strcase filter))) dip-list)) ) ) (start_list "lb") (mapcar 'add_list dialog-list) (end_list) (set_tile "tp" (strcat " selected " (itoa (length dialog-list)) " of " (itoa (length dip-list)))) ) ;;; helper functions ;;; determine status caps lock for when typing filter (even though filter uses strcase) (defun case (s) (cond ((null s) "") ((not (eq (type s) 'STR)) "") ((null capslock) s) (t (if (= (acet-sys-keystate 20) 0) (strcase s t) (strcase s))))) ;;; generate number (gnum 1 5) -> '(1 2 3 4 5) (defun gnum (s e / i l) (and (numberp s)(numberp e)(setq i s)(while (<= i e)(setq l (cons i l) i (1+ i)))) (reverse l)) ; (SplitStr "a,b" ",") -> ("a" "b") (defun SplitStr (s d / p) (if (setq p (vl-string-search d s))(cons (substr s 1 p)(SplitStr (substr s (+ p 1 (strlen d))) d))(list s))) ;;; d = directory , e = extension like "*.dwg" , f = flag include subfolders (any value or nil) (defun alf (d e f) (setq d (vl-string-right-trim "/" (vl-string-translate "\\" "/" d))) (if f (apply 'append (cons (if (vl-directory-files d e)(mapcar '(lambda (x) (strcat d "/" x)) (vl-directory-files d e))) (mapcar '(lambda (x) (alf (strcat d "/" x) e f))(vl-remove ".." (vl-remove "." (vl-directory-files d nil -1)))))) (mapcar '(lambda (x) (strcat d "/" x))(vl-directory-files d e 1)))) ; generic getfolder routine with possibility to create a new subfolder (GetShellFolder "select path") (defun GetShellFolder ( m / f s) (if (and (setq s (vlax-create-object "Shell.Application")) (setq f (vlax-invoke s 'browseforfolder 0 m 65536 "")))(setq f (vlax-get-property (vlax-get-property f 'self) 'path)) (setq f nil))(vl-catch-all-apply 'vlax-release-object (list s)) (if f (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" f)) "\\"))) ; returns T if no errors occurred during program execution (defun ShellOpen ( $f / it sh ) (if (and (not (void $f)) (setq $f (findfile $f)) (setq sh (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application"))) (progn (setq it (vl-catch-all-apply 'vlax-invoke (list sh 'open $f)))(vlax-release-object sh)(not (vl-catch-all-error-p it))) (progn (prompt "\nShell application was unable to open file")(setq it nil)))) (defun void (x) (or (eq x nil) (and (listp x)(not (vl-consp x))) (and (eq 'STR (type x)) (eq "" (vl-string-trim " \t\r\n" x))))) ;;; test function (defun c:t1 () (setq lst (dip (alf (car (fnsplitl (findfile "acad.exe"))) "*.dwg" t))) (alert (apply 'strcat (mapcar '(lambda (x)(strcat x "\n")) lst))) ) ;;; select a folder , app finds all files , don't click anything but just start typing and list will be updated with filter you typed ;;; after that all files left will be opened so don't try to open 100 autocad drawings at once... (defun c:t2 ( / fol lst dip-list) (if (and (setq fol (GetShellFolder "Select folder to search")) (vl-consp (setq lst (alf fol "*.*" t))) (vl-consp (setq dip-list (dip lst)))) (foreach f dip-list (ShellOpen f))))

@mostafa_mashhadi In simplest terms: (command "._line" pause "_per" pause); draw a line using the "per" (perpendicular) object snap. 1st PAUSE is selected "P1", 2nd PAUSE is the selected point on the line. (setq p2 (getvar "lastpoint")); P2 stores the last point selected, modified to be perpendicular to the line Did you want a more mathematical solution? Please be more specific. - Is the existing line segment just a LINE or a part of a POLYLINE, could it be both? Here is another trick solution I have used which doesn't require that much code: (defun c:foo (/ rp lp1 lp2 a p2 pp sl) (if (and (setq sl (entsel "\nPick a point on the line: ")) (setq rp (cadr sl) lp1 (osnap rp "mid") lp2 (osnap rp "end") a (angle lp1 lp2)) (setq p2 (getpoint "\nSelect Perpendicular source point: ")) ) (progn (setq pp (inters lp1 lp2 p2 (polar p2 (+ a (/ pi 2)) 1.0) nil)) (command "._line" "_non" pp "_non" p2 "") (princ (strcat "\nPerpendicular Coordinate: " (rtos (car pp)) "," (rtos (cadr pp)) "," (rtos (caddr pp)))) ) ) (princ) ) NOTE: the coordinates of the point you want are stored in variable "pp". EDIT - I updated the 1st pick to be a select box for the line for easier selection.

The reason for scaled drawings is so someone with a standard engineering or architectural scale can use them to check distantances on plotted drawings. Like BIGAL pointed out using a scale not found on either of them serves no purpose whatsoever.

1:85 is not a normal metric scale 1:50 or 1:100 would be a ore correct scale.

It sounds like your model space drawing units is set to meters not millimeters for starters.

Current LineWeight is stored in celweight SysVar. -1 means "Bylayer"; -2 is "ByBlock; -3 is "Default". But if you want the value of current LineWeigth try this (if (minusp (setq celw (getvar 'celweight))) (nth (+ 3 celw) (list (getvar 'lwdefault) "ByBlock" (vla-get-Lineweight (vla-item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (getvar 'clayer))) ) ) celw ) "Byblock" has no meaning until you use newly created object in a block and set Lweight for that block. And keep in mind that the value returned is 100 times the real value (25 instead 0.25, for metric units)