All Activity
- Past hour
-
Create lisp code for text above polyline
Saxlle replied to karfung's topic in AutoLISP, Visual LISP & DCL
I'v never taste the Durian . -
Create lisp code for text above polyline
Saxlle replied to karfung's topic in AutoLISP, Visual LISP & DCL
You're welcome @karfung . I'm from Serbia. I have made changes to the code, please try it now (I hope I understand your requirements correctly). If it's not, try to change in sub-function "fix_value" the value from "500" to any other to get desired result. The fix function round up the real number into the nearest smallest integer number (for e.g. if you have a 3.70 m, and when you add 0.50 m, you will get 4.20 m, but using fix function which is an AutoLISP Core Function, you will get 4.0 m, also if you have 4.70 m, you will also get 4.0 m). Just an explanation to understand the logic. ; ************************************************************************************************** ; Functions : PLMTXT ; Sub-functions : ang_check_text, fix_value ; Description : Add predifined text with the 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 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 (/ (fix_value (distance pt1 pt2)) 1000) ;; 1000 mm equal to 1.0 m 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 (/ (fix_value (distance pt1 pt2)) 1000) ;; 1000 mm equal to 1.0 m 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 (/ (fix_value (distance pt1 pt2)) 1000) ;; 1000 mm equal to 1.0 m 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) ) ) ) ;; Sub-function to round up number to the whole integer (defun fix_value (val) (if (not (minusp val)) (setq val (fix (+ val 500))) ;; 500 mm equal to 0.50 m (setq val (fix (- val 500))) ;; 500 mm equal to 0.50 m ) ) Best regards. - Today
-
CevAlexandru joined the community
-
Create lisp code for text above polyline
karfung replied to karfung's topic in AutoLISP, Visual LISP & DCL
Please contact me when you reach here. I buy you durian. -
Create lisp code for text above polyline
karfung replied to karfung's topic in AutoLISP, Visual LISP & DCL
@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. -
Danielm103 started following Create lisp code for text above polyline
-
Create lisp code for text above polyline
Danielm103 replied to karfung's topic in AutoLISP, Visual LISP & DCL
I am from Malaysia. Land of Durian, yummy -
Danny started following 2016 max Installation issues on Win 11 25H2
-
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?
-
Create lisp code for text above polyline
karfung replied to karfung's topic in AutoLISP, Visual LISP & DCL
@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. -
Danielm103 started following 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) )
-
Saxlle started following Create lisp code for text above polyline
-
Create lisp code for text above polyline
Saxlle replied to karfung's topic in AutoLISP, Visual LISP & DCL
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. -
RR_real joined the community
-
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
-
Repair Lisp to create superimpose acad
karfung replied to karfung's topic in AutoLISP, Visual LISP & DCL
@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? -
Repair Lisp to create superimpose acad
rlx replied to karfung's topic in AutoLISP, Visual LISP & DCL
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 -
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.
-
hs0wkc joined the community
-
Repair Lisp to create superimpose acad
karfung replied to karfung's topic in AutoLISP, Visual LISP & DCL
@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. - Yesterday
-
Inactive Edit boxes in some places in the Dialog box.
BIGAL replied to Dayananda's topic in AutoLISP, Visual LISP & DCL
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. -
Inactive Edit boxes in some places in the Dialog box.
Steven P replied to Dayananda's topic in AutoLISP, Visual LISP & DCL
I'd forgotten mode_tile there, yes, that is the one to go for. -
rlx started following Inactive Edit boxes in some places in the Dialog box.
-
Inactive Edit boxes in some places in the Dialog box.
rlx replied to Dayananda's topic in AutoLISP, Visual LISP & DCL
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")))) -
Repair Lisp to create superimpose acad
rlx replied to karfung's topic in AutoLISP, Visual LISP & DCL
;;; 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)) -
Steven P started following Inactive Edit boxes in some places in the Dialog box.
-
Inactive Edit boxes in some places in the Dialog box.
Steven P replied to Dayananda's topic in AutoLISP, Visual LISP & DCL
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 -
mhupp started following Inactive Edit boxes in some places in the Dialog box.
-
Inactive Edit boxes in some places in the Dialog box.
mhupp replied to Dayananda's topic in AutoLISP, Visual LISP & DCL
Make it a text not edit_box -
anish.bhavsar joined the community
-
toton joined the community
-
Perform hatch without superfluous requests
Nikon replied to Nikon's topic in AutoLISP, Visual LISP & DCL
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 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). * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -
Perform hatch without superfluous requests
Nikon replied to Nikon's topic in AutoLISP, Visual LISP & DCL
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) ) -
Inactive Edit boxes in some places in the Dialog box.
Dayananda posted a topic in AutoLISP, Visual LISP & DCL
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 -
Repair Lisp to create superimpose acad
karfung replied to karfung's topic in AutoLISP, Visual LISP & DCL
@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. - Last week
-
Perform hatch without superfluous requests
Nikon replied to Nikon's topic in AutoLISP, Visual LISP & DCL
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.
