Jump to content

All Activity

This stream auto-updates

  1. Today
  2. Tsuky

    Segments of polylines

    Maybe another function that could help you... It is essential to set the "RESOL" variable to your resolution wishes before starting the routine, note that this modifies the geometry data of all selected objects. (defun round_number (xr n / ) (* (fix (atof (rtos (* xr n) 2 0))) (/ 1.0 n)) ) (defun c:regular_draw ( / js n_count ent dxf_ent dxf_lst) (setq js (ssget '((0 . "FACE3D,ARC,ATTDEF,ATTRIB,CIRCLE,ELLIPSE,INSERT,LINE,POLYLINE,LWPOLYLINE,*TEXT,POINT,SHAPE,SOLID,TRACE"))) n_count -1) (cond (js (setvar "cmdecho" 0) (command "_.undo" "_group") (while (setq ent (ssname js (setq n_count (1+ n_count)))) (setq dxf_ent (entget ent)) (cond ((eq (cdr (assoc 0 dxf_ent)) "LWPOLYLINE") (setq dxf_lst (cdr dxf_ent) dxf_ent (list (car dxf_ent))) (while (cdr dxf_lst) (if (eq 10 (caar dxf_lst)) (setq dxf_ent (cons (cons 10 (mapcar '(lambda (x p) (round_number x (/ 1 p))) (cdar dxf_lst) (getvar "SNAPUNIT"))) dxf_ent)) (setq dxf_ent (cons (car dxf_lst) dxf_ent)) ) (setq dxf_lst (cdr dxf_lst)) ) (setq dxf_ent (reverse dxf_ent)) ) ((eq (cdr (assoc 0 dxf_ent)) "POLYLINE") (while (eq (cdr (assoc 0 (setq dxf_ent (entget (entnext (cdar dxf_ent)))))) "VERTEX") (setq dxf_ent (subst (cons 10 (mapcar '(lambda (x p) (round_number x (/ 1 p))) (cdr (assoc 10 dxf_ent)) (append (getvar "SNAPUNIT") (list (car (getvar "SNAPUNIT")))))) (assoc 10 dxf_ent) dxf_ent)) (entmod dxf_ent) ) ) (T (foreach n dxf_ent (if (member (car n) '(10 11 12 13 40)) (if (listp (cdr n)) (setq dxf_ent (subst (cons (car n) (mapcar '(lambda (x p) (round_number x (/ 1 p))) (cdr n) (append (getvar "SNAPUNIT") (list (car (getvar "SNAPUNIT")))))) (assoc (car n) dxf_ent) dxf_ent)) (setq dxf_ent (subst (cons (car n) (round_number (cdr n) (/ 1 (car (getvar "SNAPUNIT"))))) (assoc (car n) dxf_ent) dxf_ent)) ) ) ) ) ) (entmod dxf_ent) (entupd ent) ) (command "_.undo" "_end") (setvar "cmdecho" 1) (princ (strcat "\n" (itoa n_count) " transformed object(s).")) ) (T (princ "\nNo find valid object.")) ) (prin1) )
  3. The same, but more condensed... (vl-load-com) (defun c:label ( / l_var js htx AcDoc Space nw_style def_text n obj ename pr dist_start dist_end pt_start pt_end seg_len alpha val_txt nw_obj) (setq l_var (mapcar 'getvar '("AUNITS" "AUPREC" "LUPREC" "LUNITS"))) (mapcar 'setvar '("AUNITS" "AUPREC" "LUPREC" "LUNITS") '(4 3 0 2)) (princ "\nSelect polylines.") (while (null (setq js (ssget '((0 . "LWPOLYLINE"))))) (princ "\nSelection is empty or not are LWPOLYLINE!") ) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpecify text height <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (vla-startundomark AcDoc) (cond ((null (tblsearch "LAYER" "SNA-TXT")) (vlax-put (vla-add (vla-get-layers AcDoc) "SNA-TXT") 'color 7) ) ) (cond ((null (tblsearch "STYLE" "STANDARD")) (setq nw_style (vla-add (vla-get-textstyles AcDoc) "STANDARD")) (mapcar '(lambda (pr val) (vlax-put nw_style pr val) ) (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag) (list (strcat (getenv "windir") "\\fonts\\arial.ttf") 0.0 0.0 1.0 0.0) ) ) ) (setq def_text "BD/1:200/") (repeat (setq n (sslength js)) (setq obj (ssname js (setq n (1- n))) ename (vlax-ename->vla-object obj) pr -1 ) (repeat (fix (vlax-curve-getEndParam ename)) (setq dist_start (vlax-curve-GetDistAtParam ename (setq pr (1+ pr))) dist_end (vlax-curve-GetDistAtParam ename (1+ pr)) pt_start (vlax-curve-GetPointAtParam ename pr) pt_end (vlax-curve-GetPointAtParam ename (1+ pr)) seg_len (fix (* (- dist_end dist_start) 0.001)) alpha (angle (trans pt_start 0 1) (trans pt_end 0 1)) val_txt (strcat def_text (rtos seg_len 2 0) " m") ) (if (and (> alpha (* pi 0.5)) (< alpha (* pi 1.5))) (setq alpha (+ alpha pi))) (setq nw_obj (vla-addMtext Space (vlax-3d-point (setq pt (polar (vlax-curve-GetPointAtParam ename (+ 0.5 pr)) (+ alpha (* pi 0.5)) (getvar "TEXTSIZE")))) 0.0 val_txt ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation) (list 8 (getvar "TEXTSIZE") 5 pt "STANDARD" "SNA-TXT" alpha) ) ) ) (vla-endundomark AcDoc) (mapcar 'setvar '("AUNITS" "AUPREC" "LUPREC" "LUNITS") l_var) (prin1) )
  4. Yesterday
  5. Danielm103

    Segments of polylines

    Nice!
  6. Sure @karfung, but I will leave you to do that (I'm writing from the phone). This is the hint, find it everywhere in the code: (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")))) Find this part inside: Replace this part: (cons 1 (strcat def_text (rtos lenSegment 2 2) " m")) With this: (cons 1 (strcat def_text (itoa lenSegment) " m")) and you will get the whole integer without the decimal part. I've heard the Durian, but never taste it. If I ever come to Malaysia, I will taste it . Best regards.
  7. marko_ribar

    Segments of polylines

    @Danielm103 How can AI be better than human revision? Here is AI - I've added "red" color... (defun c:ortho_pline ( / orthogonalize-points edata ent newpts p pl pts x) (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 ) ) ) (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) (list '(62 . 1)) ) ) ) (if pl (princ "\nOrthogonal polyline created.") (princ "\nFailed to create polyline.") ) (princ) ) And here is my version - I used "green" color... (defun c:lw_orth ( / f lw lwx pl ) (defun f ( l / i p1 p2 r ) (if (> (length l) 2) (progn (setq i -1) (while (< (setq i (1+ i)) (1- (length l))) (if (not p1) (setq p1 (nth i l) p2 (nth (1+ i) l)) (setq p1 p2 p2 (nth (1+ i) l)) ) (if (= i 0) (setq r (cons (car l) r)) ) (if (< (abs (- (car p2) (car p1))) (abs (- (cadr p2) (cadr p1)))) (setq r (cons (setq p2 (list (car p1) (cadr p2))) r)) (setq r (cons (setq p2 (list (car p2) (cadr p1))) r)) ) (if (= i (- (length l) 2)) (setq r (cons (last l) r)) ) ) (setq r (reverse r)) (setq r (apply (function append) (mapcar (function (lambda ( p1 p2 / pp ) (if (setq pp (vl-some (function (lambda ( x ) (if (and (equal (distance p1 p2) (+ (distance p1 x) (distance x p2)) 1e-10) (not (equal x p1 1e-10)) (not (equal x p2 1e-10))) x))) l)) (list p1 pp) (list p1)))) r (append (cdr r) (list (car r)))))) ) ) ) (if (and (setq lw (car (entsel "\nPick open polygonal lwpolyline to make its clone orthogonalized..."))) (= (cdr (assoc 0 (setq lwx (entget lw)))) "LWPOLYLINE") (or (= (cdr (assoc 70 lwx)) 0) (= (cdr (assoc 70 lwx)) 128)) (vl-every (function (lambda ( x ) (= (cdr x) 0.0))) (vl-remove-if (function (lambda ( x ) (/= (car x) 42))) lwx)) ) (progn (setq pl (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) lwx))) (if (> (length pl) 2) (entmake (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length pl)) (cons 70 (* 128 (getvar (quote plinegen)))) (cons 38 0.0) ) (mapcar (function (lambda ( x ) (cons 10 x))) (f pl)) (list (cons 62 3) (list 210 0.0 0.0 1.0) ) ) ) (prompt "\nPicked lwpolyline with insufficient number of vertices...") ) ) (prompt "\nMissed, or picked entity not open polygonal lwpolyline... Better luck next time...") ) (princ) ) In attached *.DWG you can see that AI version makes mistake with finalizing segment - it isn't always orthogonal... Anyway interesting and fun for coding... Regards, M.R. orthogonalize_lwpolyline.dwg
  8. Well I was born on Mars (and my wife on Venus) and because of my job I currently live in NL
  9. @Saxlle Is King of the fruit. Is local product from Southeast Asia. @Saxlle Could remove the decimal .00 (2 zero). Eventually, show the integer with unit m only. Kindly advise. Thanks.
  10. @rlx Thanks. I am from Malaysia. May I know where you're from?
  11. Steven P

    Segments of polylines

    A slightly blunter method I use is to line everything up to a grid spacing (in my LISP I define the spacing rather than the drawing.... just in case) which usually works OK for most thing. A lot of what I do is line diagrams and the polylines are never too far out. - Get a list of points, use Lee Macs round to closest on each point, entmod the line using original and new points. I'd prefer entmod than making a new line just in case something goes wrong in between deleting the original and creating the new, retains all the original polyline info.
  12. just look in autocad help for LUNITS & INSUNITS https://help.autodesk.com/view/ACD/2025/ENU/?guid=GUID-A58A87BB-482B-4042-A00A-EEF55A2B4FD8
  13. I'v never taste the Durian .
  14. 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.
  15. Please contact me when you reach here. I buy you durian.
  16. @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.
  17. I am from Malaysia. Land of Durian, yummy
  18. 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?
  19. @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.
  20. 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) )
  21. 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.
  22. 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
  23. @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?
  24. 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
  25. 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.
  26. @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.
  27. Last week
  28. 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.
  1. Load more activity
×
×
  • Create New...