All Activity

maybe something like this (untested) ;;; copy & paste for dummies - rlx 2025-10-18 (defun c:capfd ( / this-dwg ss other-dwg blocknames-in-selectionset blocknames-in-other-dwg duplicate-blocknames) (setq this-dwg (vla-get-ActiveDocument (vlax-get-acad-object))) (if (and (setq ss (ssget)) (setq other-dwg (getfiled "Copy SS to:" "" "dwg" 0))) (progn (setq blocknames-in-selectionset (Get_SS_BlockNames ss)) (setq blocknames-in-other-dwg (Get_DBX_Blocknames other-dwg)) (setq duplicate-blocknames (compare_block_names blocknames-in-selectionset blocknames-in-other-dwg)) (if (vl-consp duplicate-blocknames) (progn (dplm duplicate-blocknames "Duplicated block names : ") (if (yes_no "Copy anyway?") (ctd ss other-dwg) (princ"\nBite me...") ) ) (ctd ss other-dwg) ) ) ) (princ) ) (defun compare_block_names (a b / c) (and (vl-consp a) (vl-consp b) (foreach item a (if (member item b) (setq c (cons item c))))) c) (defun Get_SS_BlockNames ( ss / n l) (foreach o (ss->ol ss) (if (and (block-p o)(not (member (setq n (block-n o)) l))) (setq l (cons n l)))) l) (defun SS->OL (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) ; (block-p (vlax-ename->vla-object (car (entsel)))) (defun block-p (o) (and (= 'vla-object (type O))(eq (vla-get-objectname O) "AcDbBlockReference"))) (defun block-n (o) (if (and (= 'vla-object (type O))(eq (vla-get-objectname O) "AcDbBlockReference")) (if (vlax-property-available-p o 'EffectiveName)(vla-Get-EffectiveName o)(vla-Get-Name o)) nil)) ; (yes_no "Do you like snow") (defun yes_no ( $m / f p i r ) (and (= (type $m) 'STR) (setq f (vl-filename-mktemp ".dcl")) (setq p (open f "w")) (write-line (strcat "yesno:dialog{label=\"" $m "?\";ok_cancel;}") p) (progn (close p)(gc) t) (setq i (load_dialog f)) (new_dialog "yesno" i) (progn (action_tile "accept" "(done_dialog 1)")(action_tile "cancel" "(done_dialog 0)") (setq r (start_dialog))(unload_dialog i)(vl-file-delete f) t)(if (= r 1) t nil))) ;;; display list (plus message) (defun dplm (l m / f p d w) (and (vl-consp l) (setq l (mapcar 'vl-princ-to-string l)) (setq w (+ 5 (apply 'max (mapcar 'strlen l)))) (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ (strcat "cfl:dialog{label=\"" m "\";:list_box {key=\"lb\";" "width="(itoa w)";}ok_only;}") p)(not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)(progn (start_list "lb") (mapcar 'add_list l)(end_list)(action_tile "accept" "(done_dialog)")(start_dialog)(unload_dialog d)(vl-file-delete f)))) ;;; copy to drawing (defun ctd ( ss dwg / ss->ol dbx_ver acApp acDoc dbx object-list object-safe-array) (defun SS->OL (ss / i l) (setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) (defun dbx_ver ( / v) (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))) (setq acApp (vlax-get-acad-object) acDoc (vla-get-ActiveDocument acApp)) (setq dbx (vl-catch-all-apply 'vla-getinterfaceobject (list acApp (dbx_ver)))) (vla-open dbx dwg) ; put all block objects in a list (setq object-list (ss->ol ss)) ; put list with objects in a safe array (setq object-safe-array (vlax-make-safearray vlax-vbobject (cons 0 (1- (length object-list))))) (vl-catch-all-apply 'vlax-safearray-fill (list object-safe-array object-list)) ; copy objects to dbx-drawing (vla-CopyObjects acDoc object-safe-array (vla-get-ModelSpace dbx)) (vl-catch-all-apply 'vla-saveas (list dbx dwg)) (vl-catch-all-apply 'vlax-release-object (list dbx)) (setq object-list nil object-safe-array nil) (princ) ) ; test : (setq lst (GetDocBlockNames (vla-get-ActiveDocument (vlax-get-acad-object)))) ; returns sorted list (uppercase) like : ("BLOCK_A" "BLOCK_B" ...) (defun GetDocBlockNames (d / o n l) (vlax-for o (vla-get-blocks d)(if (and (= :vlax-false (vla-get-isxref o))(= :vlax-false (vla-get-islayout o)) (snvalid (setq n (vla-get-name o)) 0))(setq l (cons (strcase n) l))))(if (vl-consp l)(acad_strlsort l))) (defun Get_DBX_Blocknames ( doc-name / lst v objectdbx-document) (cond ((not (eq (type doc-name) 'STR)) (princ (strcat "\nInvalid filename : " (vl-princ-to-string doc-name)))) ((not (findfile doc-name)) (princ (strcat "\nFile not found : " (vl-princ-to-string doc-name)))) (t (vlax-for doc (vla-get-Documents (vlax-get-acad-object)) (and (eq (strcase (vla-get-fullname doc)) (strcase doc-name))(setq objectdbx-document doc))) (cond ((eq (type objectdbx-document) 'VLA-OBJECT)) ((not (setq objectdbx-document (vlax-create-object (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))))) (princ "\nUnable to start object dbx")) ((vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list objectdbx-document doc-name))) (princ (strcat "\nOdbx error - unable to acces : " doc-name))) (t (setq lst (GetDocBlockNames objectdbx-document))) ) ) ) (vl-catch-all-apply 'vla-close (list objectdbx-document :vlax-False)) (if (and (= 'vla-object (type objectdbx-document))(not (vlax-object-released-p objectdbx-document))) (vlax-release-object objectdbx-document)) (if (vl-consp lst) (mapcar 'strcase lst)) )

Could do it with pure LISP rather than reactors, a new name though ("CopyWithBlocks" and "PasteWithBlocks" or something like that. CwB, PwB) Weekend so CAD is off but something like this Copy: Select all the entities required in a selection set Select the basepoint (or use a nominal one if necessary) Loop through the selection set to find all the block names Save this list as a variable - or if you want to be really clever - add this list to the copied information (never tried that but I think it is possible), perhaps as xdata in a point or something that can later be found and deleted Copy to clipboard: (vl-cmdf "_.copyclip" basepoint MySS "") (vl-cmdf "_.copybase" basepoint MySS "") Paste: Find the list of blocks from the xdata, and create a list of blocks in the target drawing Compare the 2 lists and give any warnings necessary If OK, paste. If not OK don't paste.

Thank you very much, I also thought that the solution was to use Reactors... but creating a Lisp of this kind is way beyond my abilities! I hope that someone among the 'gurus' of this forum can help me. Thank you.

It would be nice to add a request along with the warning.: (setq choice (getkword "[Continue/caNcel/Rename/Add-index-1] <Rename>: "))

Sir, just I change date value 0 to 1, because dautm value and line is always varies. Program working perfectly for zero 0 datum value and line, if dautm value and line change, not getting accurate level , this attachment. Thanks DATUM VALUE CHANGE.dwg

Perhaps someone knows a better way. In my opinion, this could be done with reactors. That is, in your AutoCAD session, there should be two latent reactors: one that activates after "copyclip" is executed and looks for the most recent DWG in the "temp" folder and saves its name in a global variable; and another that activates just before "pasteclip" is executed (:vlr-commandWillStart) and tracks the blocks of the DWG where the "copyclip" was created and the blocks of the current drawing. There may already be a Lisp published in this forum that does this job, and some veteran can help you locate it.

@Ish, if you don't mind, can you please attach video, gif, picture, etc. of the problem which you issued, because I'm not sure to fully understand the problem. Thanks

I made a stupid mistake and now I would like to find a way to avoid it: I copied a portion of a drawing (using CTRL+C) and pasted it into another (CTRL+V). The problem is that the copied part contained blocks that were already present with the same name in the new drawing. However, the blocks in the new drawing were slightly different. Is it possible to create a lisp or something that warns: 'Attention: the drawing already contains blocks named XXXX'?

Thanks for your help sir, one issue I notice, if I change the datum value and keep datum line same ,value of intersection point not coming accurate, only start vertex and and vertex is accurate. Note : Same section but change datum value.

This takes into account a datum and scale, metric only. You need dummy text as it updates the text. Note this was written in 2014. SurfaceRL.lsp

I think this code should meet what you need. ;************************ G L A V C V S ************************* ;************************** F E C I T *************************** (defun c:subTexta (/ e n le vlae txu tx cj g? tg) (vl-catch-all-apply '(lambda () (while (or (/= (setq tx (getstring (strcat "\nType TEXT to add to DIMENSION (escape to EXIT) " (if tx (strcat "<" tx ">") "") ": "))) "") txu) (set (if (= tx "") 'tx 'txu) (if (= tx "") txu tx)) (setq n nil cj (ssget "_:L" '((0 . "*DIMENSION")))) (while (setq e (ssname cj (setq n (if n (1+ n) 0)))) (setq g? (/= (setq tg (vla-get-Textoverride (setq vlae (vlax-ename->vla-object e)))) "")) ;(vla-put-Textoverride vlae (if g? (strcat tg (if (wcmatch tg "*\\X*") "\n" "\\X") tx) (strcat tg "<>\\X" tx)));ACTIVA ESTA LÍNEA SI QUIERES EVITAR QUE PONGA EL SIGNO + DELANTE DEL PRIMER TEXTO Y DESACTIVA LA SIGUIENTE LÍNEA DE CODIGO (vla-put-Textoverride vlae (if g? (strcat (if (wcmatch tg "+*") "" "+") tg (if (wcmatch tg "*\\X*") "\n" "\\X") tx) (strcat "+" (rtos (vla-get-Measurement vlae) 2 (vla-get-PrimaryUnitsPrecision vlae)) "\\X" tx))) ) ) ) ) (princ) )

thank you for your suggestion

Long time I'm nothing written in Lisp. So, I hoppe it will serve you. Also, you can saw a short video how it works. The code: (prompt "\nTo run a LISP type: yval") (princ) (defun c:yval ( / old_osmode pline spt ept spt_pline ept_pline datum_line yval_datum_line yval_start_pline yval_end_pline txt_position ang_spt_pline ang_ept_pline datum_value intersecting_lines len i int_pt_pline int_pt_datum_line dist yval_position ang) (setq old_osmode (getvar 'osmode)) (setq pline (car (entsel "\nSelect Polyline to get an Elevation:"))) (while (or (equal pline nil) (not (equal "LWPOLYLINE" (cdr (assoc 0 (entget pline)))))) (prompt "\nSelected entity must be LWPOLYLINE. Try again...\n") (setq pline (car (entsel "\nSelect Polyline to get an Elevation:"))) ) (setq spt_pline (vlax-curve-getStartPoint pline) ept_pline (vlax-curve-getEndPoint pline) ) (if (> (car spt_pline) (car ept_pline)) (progn (command-s "_reverse" pline "") (setq spt_pline (vlax-curve-getStartPoint pline) ept_pline (vlax-curve-getEndPoint pline) ) ) ) (setq datum_line (car (entsel "\nSelect Datum Line:"))) (while (or (equal datum_line nil) (not (equal "LINE" (cdr (assoc 0 (entget datum_line)))))) (prompt "\nSelected entity must be LINE. Try again...\n") (setq datum_line (car (entsel "\nSelect Datum Line:\n"))) ) (setq yval_datum_line (cadr (vlax-curve-getStartPoint datum_line)) yval_start_pline (- (cadr spt_pline) yval_datum_line) yval_end_pline (- (cadr ept_pline) yval_datum_line) ) (setq txt_position (getpoint "\nPick the lower-left corner of the box for elevation value:\n")) (setvar 'osmode 0) (setq datum_value (car (entsel "\nSelect Datum value:"))) (if (equal "MTEXT" (cdr (assoc 0 (entget datum_value)))) (setq datum_value (LM:UnFormat (cdr (assoc 1 (entget datum_value))) T)) (setq datum_value (cdr (assoc 1 (entget datum_value)))) ) (setq ang_spt_pline (angle (setq yval_position_one (list (car spt_pline) (+ (cadr txt_position) 0.1) (caddr txt_position))) spt_pline) ang_ept_pline (angle (setq yval_position_two (list (car ept_pline) (+ (cadr txt_position) 0.1) (caddr txt_position))) ept_pline) ) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos (+ yval_start_pline (atof datum_value)) 2 3)) (cons 10 yval_position_one) (cons 11 yval_position_one) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_spt_pline))) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos (+ yval_end_pline (atof datum_value)) 2 3)) (cons 10 yval_position_two) (cons 11 yval_position_two) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_ept_pline))) (princ "\nSelect intersecting lines:") (setq intersecting_lines (ssget (list (cons 0 "LINE") (cons 8 "DATUM-GRID"))) len (sslength intersecting_lines) i 0 ) (while (< i len) (setq int_pt_pline (vlax-safearray->list (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object pline) (vlax-ename->vla-object (ssname intersecting_lines i)) acExtendNone))) int_pt_datum_line (vlax-safearray->list (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object datum_line) (vlax-ename->vla-object (ssname intersecting_lines i)) acExtendNone))) dist (distance int_pt_pline int_pt_datum_line) yval_position (list (car int_pt_pline) (+ (cadr txt_position) 0.1) (caddr txt_position)) ang (angle yval_position int_pt_pline) i (1+ i) ) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos dist 2 3)) (cons 10 yval_position) (cons 11 yval_position) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_spt_pline))) ) (setvar 'osmode old_osmode) (prompt "\nAn elevation values were added!") (princ) ) ;;-------------------=={ UnFormat String }==------------------;; ;; ;; ;; Returns a string with all MText formatting codes removed. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; str - String to Process ;; ;; mtx - MText Flag (T if string is for use in MText) ;; ;;------------------------------------------------------------;; ;; Returns: String with formatting codes removed ;; ;;------------------------------------------------------------;; (defun LM:UnFormat ( str mtx / _replace rx ) (vl-load-com) (defun _replace ( new old str ) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new) ) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda ( ) (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '( ("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_replace "\\" "\032" str) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) The short video: YVAL.mp4 Best regards.

Dear Members, I have a ployline with dautm text value and datum line , I want text label of pline start vertex, intersection pont and end vertex, based on datum. If any have plz share need only y value, elevation, level of pline . Thanks See attached cad file Thanks POLYLINE Y VALUE.dwg

I made mistake, this works only for text. As for mtext, should be: entmakex with plain content and then vla-put-Textstring with the field expression.

Give this a try, allows up to 4 values. Probably needs a bit of fine tuning. Only use it with a single line dim. Can add more lines and can change width of boxes look at 20 19. ; Add more lines to a normal Dimension ; By AlanH Oct 2025 (defun c:incdim ( / obj prec ans howmany x newstr ) (setq obj (vlax-ename->vla-object (car (entsel "\nPick Dimension object ")))) (setq prec (vlax-get obj 'PrimaryUnitsPrecision)) (setq tp (vlax-get obj 'TextPosition)) (if (= (setq len (vlax-get obj 'textoverride)) "") (setq newstr (rtos (vlax-get obj 'measurement) 2 prec)) ) (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (setq ans (AH:getvalsm (list "Enter values " "line 1 " 20 19 newstr "line 2 " 20 19 "" "Line 3" 20 19 "" "Line 4" 20 19 ""))) (setq howmany "Yes") (setq x 0) (while (= howmany "Yes") (setq str (nth (setq x (1+ x)) ans)) (setq newstr (strcat newstr "\n" str )) (if (or (= x 3)(= str ""))(setq howmany "No")) ) (vlax-put obj 'textoverride newstr) (vlax-put obj 'TextPosition tp) (princ) ) (c:incdim)

Another By @Lee Mac Area.lsp look on his web site. https://www.lee-mac.com/arealabel.html

Have you defined the variables 'myfilepath' and 'myfilename' somewhere? If not, these symbols will evaluate to nil, yielding the error you have described.

The answers you seek can be found in the thread entitled... "Penn Foster Student Suffering with Oleson Village Map." I know this because I contributed instructions as well as images. Many P-F students have found the thread beneficial.

Hi It's not certain that all the functions in this code will work in AutoCAD LT. Try it. (defun c:guardA (/ v nvoD f?) (setq v (member (vla-get-saveAsType (vla-get-openSave (vla-get-preferences (vlax-get-acad-object)))) (list acr14_dwg "v14" ac2000_dwg "v2000" ac2004_dwg "v2004" ac2007_dwg "v2007" ac2010_dwg "v2010" ac2013_dwg "v2013" ac2018_dwg "v2018"))) (setq f? (if (not (vl-directory-files (setq nvoD (strcat (getvar "DWGPREFIX") "EXPORTED\\")))) (VL-MKDIR nvoD) T)) (vla-saveas (vla-get-activedocument (vlax-get-acad-object)) (strcat (if f? nvoD (getvar "DWGPREFIX")) (VL-FILENAME-BASE (getvar "DWGNAME")) "-EXPORTED_" (cadr v) ".dwg") (car v)) (princ "\nDone!") (princ) )

Thanks, I found this lisp that works for me. If anyone is interested here is the link. Visibility Selection

LT is not brilliant with VLA- or VL- commands so best really avoid them for now. Perhaps not the most efficient method but try the (command "_.saveas" ...... ) method

... have you tested that...

Here are two good options from Lee Mac

Hi all, I've been trying to accomplish what I thought would be an easy thing, but despite hours of searching I can't seem to get it to work! I'm trying to create a lisp that I can run in AutoCAD LT (2025) that does a "SAVE AS" and simply adds " - EXPORTED" as a suffix onto the original filename. I'd like this to happen without any dialogue boxes popping up, and If it could have the following features it would be absolutley perfect (but these arent crucial). 1. specify the file version from within the lisp 2. save the exported versions into a folder within the same directory called "exported" (and overwrite previous versions if they exist) The closest I've gotten is using the below code to do the saveas, but it throws an error (; error: bad argument type: stringp nil) (defun c:TEST () (vl-load-com) (vla-SaveAs (vla-get-ActiveDocument (vlax-get-acad-object)) (strcat myfilepath myfilename ".dwg") ac2018_dwg) ) If anyone is able to help me out I'd very much appreciate it