Jump to content

All Activity

This stream auto-updates

  1. Past hour
  2. Please contact me when you reach here. I buy you durian.
  3. @Saxlle Could you do me a favour to amend the lisp code as following, 1). My default layout will be in unit mm. Could the length value of the polyline be divided by 1000? 2). The length value of the polyline is to be an integer, and any decimal is to be increased to 1. Kindly assist to amend the lisp code. Thanks.
  4. I am from Malaysia. Land of Durian, yummy
  5. Today
  6. I've been running 2016 max / Vray on win 11 installed as an in place update from win 10 for at least 2 years now. I did a fresh win11 25H2 installation, now the max installers will not unpack the exe files. When I launch the 001_001.sfx.exe it prompts the unpacker, then just shuts off. I tried shutting off all anti virus and fire wall .. VPN exe, compatibility mode, nothing seems to work, . I was able to install win 10 on a Virtual drive and the Installer worked, so its works, but obvious not an ideal work environment. Anyone have any ideas?
  7. @Saxlle Yeah, this is what I wanted. Really awesome and your prompt response. Thank you. I am from Malaysia. May I know where you from? Thanks.
  8. Danielm103

    Segments of polylines

    chat made this, (defun orthogonalize-points (pts / dx-in dx-out dy-in dy-out i in-is-h new-x new-y out-is-h p0 p1 p2 result) ;; If fewer than 3 points, nothing to do (if (< (length pts) 3) pts (progn (setq result pts) ;; Iterate interior vertices (setq i 1) (while (< i (- (length pts) 1)) (setq p0 (nth (- i 1) result)) (setq p1 (nth i result)) (setq p2 (nth (+ i 1) result)) ;; Incoming vector p0 -> p1 (setq dx-in (- (car p1) (car p0))) (setq dy-in (- (cadr p1) (cadr p0))) ;; Outgoing vector p1 -> p2 (setq dx-out (- (car p2) (car p1))) (setq dy-out (- (cadr p2) (cadr p1))) ;; Dominant direction tests (setq in-is-h (>= (abs dx-in) (abs dy-in))) (setq out-is-h (>= (abs dx-out) (abs dy-out))) ;; Case 1: Proper corner (one horizontal, one vertical) (cond ((/= in-is-h out-is-h) (if in-is-h (progn ;; incoming horizontal, outgoing vertical (setq new-x (car p2)) (setq new-y (cadr p0)) ) (progn ;; incoming vertical, outgoing horizontal (setq new-x (car p0)) (setq new-y (cadr p2)) ) ) ) ;; Case 2: both horizontal (in-is-h (setq new-x (car p1)) (setq new-y (cadr p0)) ) ;; Case 3: both vertical (t (setq new-x (car p0)) (setq new-y (cadr p1)) ) ) ;; Replace interior point (setq result (subst (list new-x new-y) p1 result)) (setq i (1+ i)) ) result ) ) ) (defun c:ORTHO_PLINE ( / edata ent newpts p pl pts x) (setq ent (car (entsel "\nSelect a polyline: "))) (if (not ent) (progn (princ "\nNothing selected.") (exit) ) ) (setq edata (entget ent)) ;; Ensure LWPOLYLINE (if (/= (cdr (assoc 0 edata)) "LWPOLYLINE") (progn (princ "\nEntity is not a lightweight polyline.") (exit) ) ) ;; Extract vertices (group code 10) (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) edata))) ;; Orthogonalize (setq newpts (orthogonalize-points pts)) ;; Create new polyline (setq pl (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length newpts)) '(70 . 0) ) (mapcar '(lambda (p) (cons 10 p)) newpts) ) ) ) (if pl (princ "\nOrthogonal polyline created.") (princ "\nFailed to create polyline.") ) (princ) )
  9. Hi @karfung, Try this and see if it fits to your needs: ; ********************************************************************************************** ; Functions : PLMTXT ; Description : Add predefined text with length segment between two vertices on polyline ; Author : Saxlle ; Date : January 18, 2026 ; ********************************************************************************************** (prompt "\nTo run a LISP type: PLMTXT") (princ) (defun c:PLMTXT ( / old_osmode cur_layer old_nomutt height def_text ss len i dxf_70 plist dataList n k pt1 pt2 midPt ang dist npt pt lenSegment) (setq old_osmode (getvar 'osmode) cur_layer (getvar 'clayer) old_nomutt (getvar 'nomutt) height (getreal "\nEnter the text height <2.50>: ") ;; text height def_text "BD/1:200/" ;; default text ) (if (= height nil) (setq height 2.50) ;; defaul text height, it can be changed ) (setvar 'osmode 0) (if (not (tblsearch "LAYER" "SNA-TXT")) ;; check does layer 'SNA-TXT' exist or not (command-s "-layer" "m" "SNA-TXT" "") ;; make the SNA-TXT layer and set to be the current (command-s "-layer" "s" "SNA-TXT" "") ;; set the SNA-TXT layer to be the current ) (setvar 'nomutt 1) (princ "\nSelect POLYLINES:") (setq ss (ssget (list (cons 0 "LWPOLYLINE"))) len (sslength ss) plist (list) i 0 ) (setvar 'nomutt old_nomutt) (while (< i len) (setq dxf_70 (cdr (assoc 70 (entget (ssname ss i))))) (cond ;; the first cond ((= dxf_70 0) ;; LWPOLYLINE is OPEN (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss i)))) dataList (list) n 0 k 1 ) (repeat (setq l (length plist)) (if (< k l) (setq pt1 (nth n plist) pt2 (nth k plist) midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5)) ang (ang_check_text (angle pt1 pt2)) dist (distance pt1 pt2) npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height) dataList (append (list (list npt ang dist)) dataList) n (1+ n) k (1+ k) ) ) ) (setq dataList (reverse dataList) n 0 ) (repeat (length dataList) (setq pt (car (nth n dataList)) ang (cadr (nth n dataList)) lenSegment (caddr (nth n dataList)) n (1+ n) ) (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 11 pt) (cons 40 height) (cons 50 ang) (cons 71 5) (cons 1 (strcat def_text (rtos lenSegment 2 2) " m")))) ) ) ;; end first cond ;; the second cond ((= dxf_70 1) ;; LWPOLYLINE is CLOSED (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss i)))) dataList (list) n 0 k 1 ) (repeat (setq l (length plist)) (if (< k l) (setq pt1 (nth n plist) pt2 (nth k plist) midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5)) ang (ang_check_text (angle pt1 pt2)) dist (distance pt1 pt2) npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height) dataList (append (list (list npt ang dist)) dataList) n (1+ n) k (1+ k) ) (setq n 0 k (1- k) pt1 (nth k plist) pt2 (nth n plist) midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5)) ang (ang_check_text (angle pt1 pt2)) dist (distance pt1 pt2) npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height) dataList (append (list (list npt ang dist)) dataList) ) ) ) (setq dataList (reverse dataList) n 0 ) (repeat (length dataList) (setq pt (car (nth n dataList)) ang (cadr (nth n dataList)) lenSegment (caddr (nth n dataList)) n (1+ n) ) (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 11 pt) (cons 40 height) (cons 50 ang) (cons 71 5) (cons 1 (strcat def_text (rtos lenSegment 2 2) " m")))) ) ) ;; end second cond ) ;; end cond (setq i (1+ i)) ) (setvar 'osmode old_osmode) ;; restore osmode (setvar 'clayer cur_layer) ;; restore old layer (prompt "\nThe text was inserted!") (princ) ) ;; Sub-function to get a proper text angle (defun ang_check_text (ang) (cond ((<= ang 1.57) (setq ang ang) ) ((and (>= ang 1.57) (<= ang 3.14)) (setq ang (+ ang pi)) ) ((and (>= ang 3.14) (<= ang 4.71)) (setq ang (- ang pi)) ) ((>= ang 4.71) (setq ang ang) ) ) ) Also, see the short video example of how it works. PLMTXT.mp4 Best regards.
  10. Hi everyone, I'm a beginner and I’m currently working on an assignment that requires converting an orthographic projection to an isometric drawing in AutoCAD (beginner level). I’ve attached the link to: An image of the assignment question Option 1: my first isometric drawing Option 2: my second isometric drawing could someone please help confirm which option is correct? I’d really appreciate any guidance so I don’t carry the same mistake forward. Thank you in advance.https://imgur.com/a/nN0afna
  11. @rlx Yeah. You have complied with all my requirements. Awesome. Thanks. How about if I plan to change to another unit such as "m" or other. What is the code to be use?
  12. just feed this to the vanilla monster : (ScriptDwg fn (list "LUNITS" "2" "INSUNITS" "4" "LUPREC" "6" ".zoom" "extents")) this part is all pretty basic AutoCad
  13. Hi Team, I wish to create a Lisp code that has the following conditions, 1). Create a mtext above the new draw polyline. The mtext shall be created in every segment of the polyline. The mtext to follows the direction of the polyline. 2). The mtext to be content "BD/1:200/3.0m" above the polyline. The 3.0m is the variable that refers to the length of the particular polyline segment length. 3). The mtext to be layer SNA-TXT and text height 1000. Kindly advise the lisp code above. Thanks.
  14. @rlx Thanks for your reply & assistance. The Lisp code is really awesome. But the units in the newly created file were unitless. Could you able to set the new file with the unit in mm in the lisp code? Thanks.
  15. Yesterday
  16. My $0.05. Why have two edit boxes anyway just display the current value in a single box as you have done. Just edit that value. If you have a limited number of desirable values can put those into make a choice DCL showing the preset values.
  17. I'd forgotten mode_tile there, yes, that is the one to go for.
  18. you have a command called mode_tile , set it to 0 means enable tile and set it to 1 means disable it. (confusing so think my wife was somehow involved) https://help.autodesk.com/view/OARX/2025/ENU/?guid=GUID-23ACCF72-9C6F-45C0-A889-9307CC1210C2 lets say your top edit box is called "present_length" , to disable / gray out this edit box you would use (mode_tile "present_length" 1) in example below I've named the edit boxes "eb1" & "eb2" but I have to admit , using a text tile would have been just as easy. (defun tst1 ( $m / f p d r s) (if (and (setq f (vl-filename-mktemp ".dcl"))(setq p (open f "w"))) (progn (write-line (strcat "adjust :dialog {label =\"" $m "\";" ":edit_box {key=\"eb1\";label=\"Present Length\";}" ":edit_box {key=\"eb2\";label=\"Required Length\";}" "spacer;ok_cancel;}") p ) (close p)(gc) (setq d (load_dialog f))(new_dialog "adjust" d) (action_tile "eb1" "(setq s $value)") (action_tile "eb2" "(setq s $value)") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (set_tile "eb1" "1000") (mode_tile "eb1" 1) (setq r (start_dialog))(unload_dialog d)(vl-file-delete f) ) ) (if (and (= r 1) (= 'STR (type s)) (/= s "")) s nil) ) (alert (strcat "Required length : " (vl-princ-to-string (tst1 "Adjust bar 2026"))))
  19. ;;; 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) (gc) (foreach obj object_list (vla-delete obj)) (command ".qsave") ;|lets go vanilla|;(ScriptDwg fn (list "LUNITS" "2" "LUPREC" "6" ".zoom" "extents")) ) ) ) ) (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 ScriptDwg ( dwg-fn dwg-com / scr-fn scr-fp ) (if (= (getvar "SDI") 1) (setvar "SDI" 0)) (setq scr-fn (strcat (getvar 'MYDOCUMENTSPREFIX) "\\ScriptDwg.scr")) (cond ((or (not (= (type dwg-fn) 'STR)) (not (findfile dwg-fn))) (princ (strcat "\n*error* : unable to find drawing : " (vl-princ-to-string dwg-fn)))) ((not (setq scr-fp (open scr-fn "w"))) (princ "\n*error* : unable to create script for commands.")) ((not (vl-consp dwg-com)) (princ "\n*error* : no commands in script")) (t (write-line (_open_cmd dwg-fn) scr-fp) (mapcar '(lambda (s)(write-line s scr-fp)) dwg-com) (write-line (_close_cmd) scr-fp) ) ) (if scr-fp (progn (close scr-fp)(gc)(command "._script" scr-fn))) ) (defun _open_cmd ($fn) (strcat ".open\n\"" $fn "\"\n(while (= 1 (logand (getvar \"cmdactive\") 1))(command \"Yes\"))")) (defun _close_cmd () (eval "(if (= (getvar \"writestat\") 1)(command \".qsave\" \".close\"))")) (defun c:t1 nil (c:new_desktop_file_copy))
  20. Here are the options for edit boxes: https://help.autodesk.com/view/ACD/2026/ENU/?guid=GUID-38A11AED-DDF5-4ACA-A8BB-1F7901D0AF50 I think if you change is_enabled from true to false it should do what you want, I can't remember jus now how to switch it from one to the other - might be a google thing
  21. Make it a text not edit_box
  22. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * I recently noticed that Notepad (Windows 11) now has the ability to drag and drop selected text to Autocad or Word or another notepad file. There is no such option in Notepad (Windows 10). * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  23. It is possible to use standard hatch ANSI37. ;|= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = Changes in the code of the author Tsuky "hatch_align_vtx". https://www.cadtutor.net/forum/topic/98938-perform-hatch-without-superfluous-requests/ Replacing BAT_PUBL with the standard ANSI37. Select a closed polyline and hatch it by aligning itself to the side of the selection point. Hatch a closed polyline with ANSI37 hatch, angle 45, scale 63 (for 200x200 cells). = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =|; (vl-load-com) (defun c:hatch_align_vtx_ANSI ( / AcDoc flag *error* ent Space hatch obj_curv ) (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) ) (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) ) ) ;; standard ANSI37 (setq hatch (vla-AddHatch Space acHatchPatternTypePreDefined "ANSI37" :vlax-True)) (vlax-invoke hatch 'AppendOuterLoop (list obj_curv)) (vla-put-patternscale hatch 63.0) ; scale 63 (vla-put-patternangle hatch (/ pi 4)) ; angle 45° (in radians) (vla-evaluate hatch) ) ) ) (*error* nil) (vla-EndUndoMark AcDoc) (prin1) )
  24. In my dialog box I am displaying present length of a line in first edit box. Second edit box I am requesting the required length. and while that I want to inactive the first edit box. Please Help
  25. @rlx The latest lisp code still cannot comply to the additional condition that I mentioned before. Kindly review again. The additional condition as follows, 1). Please set the unit to be "mm" in the created file. 2). Please zoom extend for the created file. 3). (New add) At the original file, after picking the specific point for the object, please delete the selected object from the original file. This is to info user that if some of the objects weren't selected in the previous selection, it will not be deleted in this process. Kindly advise. Your assistance is appreciated. Thanks.
  26. Last week
  27. I was a bit hasty. With a scale of 200, the cell pitch is 150x150, so to get 200x200, you need to set the scale to 266.67.
  28. 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
  29. 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) )
  1. Load more activity
×
×
  • Create New...