All Activity

@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")

Couldn't open the link... I used the MHATCH.lsp code author VVA (2006). ; Thanks to the author VVA /2006/ (defun c:MHATCH ( / nab cmd osm *error*) (defun *error* (msg)(princ msg) (if cmd (setvar "cmdecho" cmd)) (if osm (setvar "osmode" osm)) (princ)) (vl-load-com) (setq cmd (getvar "cmdecho")) (setq osm (getvar "osmode")) (setvar "cmdecho" 0) (setvar "osmode" 0) (setvar "hpassoc" 1) (setq nab (ssget "_:L")) (if (and nab (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex nab))))) (foreach item lst (vl-catch-all-apply '(lambda () (command "_.-bhatch" "_s" item "" ""))))) ;_foreach (setvar "cmdecho" cmd) (setvar "osmode" osm) (princ)) I added two main lines (setvar "hpdouble" 1) - criss-cross (setvar "hpspace" 200) - spacing The code is working. Perhaps there is a simpler solution. I accept comments from the pros... ; MHATCH VVA /2006 + additions /2026 (defun c:UShatch_Doub_200 ( / nab cmd osm old_hpname old_hpang old_hpdouble old_hpspace old_hpassoc lst *error*) (defun *error* (msg) (princ msg) (if cmd (setvar "cmdecho" cmd)) (if osm (setvar "osmode" osm)) (if old_hpname (setvar "hpname" old_hpname)) (if old_hpang (setvar "hpang" old_hpang)) (if old_hpdouble (setvar "hpdouble" old_hpdouble)) (if old_hpspace (setvar "hpspace" old_hpspace)) (if old_hpassoc (setvar "hpassoc" old_hpassoc)) (princ) ) (vl-load-com) (setq cmd (getvar "cmdecho")) (setq osm (getvar "osmode")) (setvar "cmdecho" 0) (setvar "osmode" 0) (setq old_hpname (getvar "hpname")) (setq old_hpang (getvar "hpang")) (setq old_hpdouble (getvar "hpdouble")) (setq old_hpspace (getvar "hpspace")) (setq old_hpassoc (getvar "hpassoc")) (setvar "hpname" "_USER") (setvar "hpang" 0) (setvar "hpdouble" 1) (setvar "hpspace" 200) (setvar "hpassoc" 1) (setq nab (ssget "_:L")) (if (and nab (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex nab)))) ) (foreach item lst (vl-catch-all-apply '(lambda () (command "_.-bhatch" "_s" item "" "") ) ) ) ) (setvar "hpname" old_hpname) (setvar "hpang" old_hpang) (setvar "hpdouble" old_hpdouble) (setvar "hpspace" old_hpspace) (setvar "hpassoc" old_hpassoc) (setvar "cmdecho" cmd) (setvar "osmode" osm) (princ) ) (princ "Type in the command prompt UShatch_Doub_200") Thank @BIGAL, you gave me the right direction. "Maybe use (setvar 'hpname "User") in code, sets the pattern name".

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

some like it copy to desktop.dwg copy to desktop.dwg

@devitg The file was created automatically by using the Lisp code. The format within the file did not follow to the template. We shall need the Lisp code to set the created file by automatically. Thanks.

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

You can use etransmit by type "etransmit". It can plot all the individual acad files. Thanks.

@rlx Wow, your code is awesome and works very well. Thank bro. Additionally, could you assist in setting the new file with the condition as follows, 1). Please set the unit to be "mm" in the created file. 2). Please zoom extend for the created file. Kindly advise. Thanks.

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).

Spacing=200, double=yes and (setvar 'hpname old_hpname) do not work in this code Is there a solution? (defun c:HatchUserHpn ( / ss old_hpname ) (setq old_hpname (getvar 'hpname)) (setvar 'hpname "_User") (setq ss (ssget)) (if ss (progn ;; User-defined, angle=0, spacing=200, double=yes, select objects (command "BHATCH" "U" "0" "200" "D" "Y" "S" ss "" "") ;(command "_.-BHATCH" "_U" "0" "200" "_D" "_Y" "_S" ss "" "") ) ) (setvar 'hpname old_hpname) (princ) )

Hello everyone. I have been following this website for a long time and would like to kindly ask for support regarding an AutoLISP printing routine. I used AI assistance to develop a printing code, however some drawings produce no output when printed. Could anyone help me find the cause? I can provide the code and sample drawings that work and those that do not. Thank you. Desktop.rar

Hi I want to model an aircrafts winglet. I am having trouble sweeping the airfoil, curve 1, around the 60 degree's of a derived curve, (sketch 17). Initial sweeping resulted in a problem with SW maintaining tangency to the curve in sketch 17 so I added the same curve into sketch sketch 18, but I don't seem to be able to pierce it properly. Below is what happens if I 'Keep Normal Constant.' I want the left most face inclined at 60 degrees to the right most face, (i.e. not so they are parallel). Can anyone help me in making the profile incline around the Z axis as it goes round the guide curve ? I dont seem to be able to upload my SLDPRT Brgds Mark

@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

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) )

@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.

Your video did not work for me. Your LISP ran just fine on my computer.

In the future, please place your code in code tags. (<> in the editor toolbar)

Hi, everybody. It is necessary to perform hatch, regardless of the previous type of hatching. The code performs the hatch using the previous type, not the one specified in the code. ; *********** (defun c:HatchUser ( / ss) (setq ss (ssget)) (if ss (progn (command "_.-BHATCH" "_User" "_Double" "_Yes" "0" "200" "_S" ss "" "") ) ) (princ) ) HatchUserdwg.dwg

@oliver Try to reload the code at this answer

(defun c:new_desktop_file_copy (/ acad_dbx object_list zero_point) (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: ")) (foreach copied_object (setq odbx_objects_list (vlax-invoke (vla-get-database (vla-get-activedocument (vlax-get-acad-object))) 'copyobjects object_list (vla-get-modelspace acad_dbx) ) ) (vla-move copied_object (vlax-3d-point zero_point) (vlax-3d-point 0 0 0)) ) (make_color_21) (vla-saveas acad_dbx (princ (strcat (getenv "userprofile") "\\Desktop\\" (getstring "\nEnter file name: ") ".dwg"))) (vlax-release-object acad_dbx) (princ) ) Hi Bro, The LISP code above is awesome, and it is working. But, I encountered an error below and as per the attached drawing 1 with mp4 video (in link) and added it as follows, 1). Please set the unit to be "mm" in the created file. 2). Please zoom extend for the created file. fyi, I did changed the LISP code to "CP" Kindly advise and revert with the completed Lisp code. Thanks. https://drive.google.com/file/d/15VNesdJ3uHtPbUlrNbCsaP0yMzY3e2Po/view?usp=sharing Drawing1.dwg