All Activity

I'm changing the scale of the hatch in this line: ; (vla-put-patternscale hatch 1.0) (vla-put-patternscale hatch 200) Super! A completely different approach. Thanks @Tsuky

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

;;; https://www.cadtutor.net/forum/topic/98937-repair-lisp-to-create-superimpose-acad/ (defun c:new_desktop_file_copy ( / acad_dbx object_list zero_point db odbx_objects_list ss fn db actDocs doc) (vl-load-com) (setq acad_dbx (vla-getinterfaceobject (vlax-get-acad-object) (dbx_ver))) (defun make_color_21 ( / lays lay) (setq lays (vla-get-layers acad_dbx)) (vlax-map-collection (vla-get-blocks acad_dbx) '(lambda (b) (vlax-map-collection b '(lambda (o) (vla-put-color o 256) (if (/= 21 (vla-get-color (setq l (vla-item lays (vla-get-layer o))))) (vla-put-color l 21))))))) (prompt "\nPick objects to copy to a new file on the desktop...") (if (not (setq ss (ssget))) (princ "\nNothing was selected") (progn (setq object_list (ss->ol ss)) (setq zero_point (getpoint "\nPick zero point for the copied entities: ")) (setq db (vla-get-database (vla-get-activedocument (vlax-get-acad-object)))) (setq odbx_objects_list (vlax-invoke db 'copyobjects object_list (vla-get-modelspace acad_dbx))) (foreach copied_object odbx_objects_list (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) (if (eq (setq fn (getstring "\nEnter file name: ")) "") (princ (strcat "\nInvalid filename for new drawing : " (vl-princ-to-string fn))) (progn (setq fn (strcat (getenv "userprofile") "\\Desktop\\" fn ".dwg")) (vla-saveas acad_dbx fn) (vlax-release-object acad_dbx) (gc) ;;; re-open & reset drawing (setq actDocs (vla-get-documents (vlax-get-acad-object))) (if (setq doc (vla-open actDocs fn)) (progn (vla-SetVariable doc "LUNITS" 2) (vla-SetVariable doc "LUPREC" 4) (vla-zoomextents (vlax-get-acad-object)) (vla-close doc :vlax-true) (vl-catch-all-apply 'vlax-release-object (list doc)) (vl-catch-all-apply 'vlax-release-object (list actDocs)) ) (princ (strcat "\nUnable to open " (vl-princ-to-string fn))) ) ) ) ) ) (princ) ) (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))))) (defun c:t1 nil (c:new_desktop_file_copy))

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

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.