Leaderboard

Another example. This allows you to select a closed polyline and hatch it by aligning itself to the side of the selection point. (vl-load-com) (defun c:hatch_align_vtx ( / AcDoc flag *error* f_pat ent Space pr-1 pr-1 alpha hatch) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) flag T) (vla-StartUndoMark AcDoc) (defun *error* (msg) (and msg (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*")) (princ (strcat "\nError: " msg)) ) (if (= 8 (logand (getvar "UNDOCTL") 8)) (vla-endundomark AcDoc) ) (princ) ) (if (not (findfile "BAT_PUBL.pat")) (progn (setq f_pat (open (strcat (getvar "ROAMABLEROOTPREFIX") "support\\BAT_PUBL.pat") "w")) (write-line "*BAT_PUBL" f_pat) (write-line "45,0,0,0,.75" f_pat) (write-line "315,0,0,0,.75" f_pat) (close f_pat) ) ) (while (setq ent (entsel "\nSelect the long side polyline to hatch it: ")) (setq obj_curv (vlax-ename->vla-object (car ent))) (cond ((and (eq (vlax-get-property obj_curv 'ObjectName) "AcDbPolyline") (eq (vla-get-closed obj_curv) :vlax-true) ) (setq Space (if (eq (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) pr-1 (fix (vlax-curve-getParamAtPoint obj_curv (vlax-curve-getClosestPointTo obj_curv (cadr ent) nil))) pr+1 (if (>= (1+ pr-1) (fix (vlax-curve-getEndParam obj_curv))) 0 (1+ pr-1)) alpha (+ (angle (vlax-curve-getPointAtParam obj_curv pr-1) (vlax-curve-getPointAtParam obj_curv pr+1)) (* 0.25 pi)) ) (setq hatch (vla-AddHatch Space acHatchPatternTypeCustomDefined "BAT_PUBL" :vlax-True)) (vlax-invoke hatch 'AppendOuterLoop (list obj_curv)) (vla-put-patternscale hatch 1.0) (vla-put-patternangle hatch alpha) (vla-evaluate hatch) ) ) ) (*error* nil) (vla-EndUndoMark AcDoc) (prin1) )

Select at start of what you need, then shift select the end is fastest I know (you can actually go from end to the beginning as well).

somehow a document type object lives along your copied_objects so try this : (defun c:new_desktop_file_copy ( / acad_dbx object_list zero_point db) (defun make_color_21 (/ layers) (setq layers (vla-get-layers acad_dbx)) (vlax-map-collection (vla-get-blocks acad_dbx) '(lambda (block) (vlax-map-collection block '(lambda (object) (vla-put-color object 256) (if (/= 21 (vla-get-color (setq layer (vla-item layers (vla-get-layer object))))) (vla-put-color layer 21)))) ) ) ) (setq acad_dbx (vla-getinterfaceobject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." (substr (getvar 'acadver) 1 2)))) (prompt "\nPick objects to copy to a new file on the desktop...") (setq object_list (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget)))))) (setq zero_point (getpoint "\nPick zero point for the copied entities: ")) (setq db (vla-get-database (vla-get-activedocument (vlax-get-acad-object)))) (foreach copied_object (setq odbx_objects_list (vlax-invoke db 'copyobjects object_list (vla-get-modelspace acad_dbx))) (if (vlax-method-applicable-p copied_object 'move) (vla-move copied_object (vlax-3d-point zero_point) (vlax-3d-point 0 0 0)) (princ (strcat "\nUnable to move object name : " (vla-get-name copied_object))) ) ) (make_color_21) (vla-saveas acad_dbx (princ (strcat (getenv "userprofile") "\\Desktop\\" (getstring "\nEnter file name: ") ".dwg"))) (vlax-release-object acad_dbx) (princ) )

Thank @pkenewell, I will study it.

@Nikon FWIW, Here is an opportunity to show you how to store and retrieve system variables without all the extra variables in Lisp. Also - I've added undo marks to the command so everything stays together, and some stuff into the error handler. Nothing you did wrong; just showing another way to do the same thing with different techniques. ; MHATCH VVA /2006 + additions /2026 (defun c:UShatch_Doub_200 ( / d lst nab vars *error*) (defun *error* (msg) (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*quit*,*exit*")) (princ (strcat "\nError: " msg "\n")) (princ "\nProgram Aborted.\n") ) ;; Cancel any open commands. (while (not (equal (getvar "cmdnames") ""))(command-s)) ;; If uh:varlist is found, reset all the system variables to original values stored. (if uh:varlist (mapcar '(lambda (var)(setvar (car var) (cdr var))) uh:varlist) ) (while (equal 8 (logand 8 (getvar "undoctl"))) (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object))) ) (princ) ) (vl-load-com) ;; Set an undo mark (vla-StartUndoMark (setq d (vla-get-activedocument (vlax-get-acad-object)))) ;;Create an association list for the system variables and values to be set. (setq vars '(("cmdecho" . 0) ("osmode" . 0) ("hpname" . "_USER") ("hpang" . 0) ("hpdouble" . 1) ("hpspace" . 200) ("hpassoc" . 1))) ;; Gather the existing values for the system variables and add to association list "uh:varlist" (setq uh:varlist (mapcar '(lambda (var)(cons (car var) (getvar (car var)))) vars) ) ;; Set all the system variable to the values stored in "vars". (mapcar '(lambda (var)(setvar (car var) (cdr var))) vars) (if (and (setq nab (ssget "_:L")) (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex nab)))) ) (foreach item lst (vl-catch-all-apply '(lambda ()(command "_.-bhatch" "_s" item "" "")) ) ) ) (mapcar (function (lambda (var)(setvar (car var) (cdr var)))) uh:varlist ) (vla-EndUndoMark d) (princ) ) (princ "Type in the command prompt UShatch_Doub_200")

If it all goes wrong then entmake it.... This link might help, with the code from code ding https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/entmake-hatch-with-base-point-or-object-polyline-entity-name/td-p/8696712

@karfung, why not to do a Writeblock command, it allow to set units as need, and show zoom extend new block.dwg

@devitg Ok, try this. Now labels are fields. If you prefer simply Mtext, Ithink that you can change it (with previous code) mult-label_bearing.lsp

@SLW210 how to select all the code at code tags , like a short key ctrl+a or whatever

Maybe use (setvar 'hpname "User") in code, sets the pattern name.

@karfung see the new dwg new block.dwg

@karfung it seem to be you need to make a new.dwg , if so, you can use WRITEBLOCK acad command .

maybe first do an audit on this drawing

Does the LISP file load the Visual LISP ActiveX functions with (vl-load-com)? I don't see it in the code.

@oliver Try to reload the code at this answer