Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 10/17/2025 in all areas

  1. Long time I'm nothing written in Lisp. So, I hoppe it will serve you. Also, you can saw a short video how it works. The code: (prompt "\nTo run a LISP type: yval") (princ) (defun c:yval ( / old_osmode pline spt ept spt_pline ept_pline datum_line yval_datum_line yval_start_pline yval_end_pline txt_position ang_spt_pline ang_ept_pline datum_value intersecting_lines len i int_pt_pline int_pt_datum_line dist yval_position ang) (setq old_osmode (getvar 'osmode)) (setq pline (car (entsel "\nSelect Polyline to get an Elevation:"))) (while (or (equal pline nil) (not (equal "LWPOLYLINE" (cdr (assoc 0 (entget pline)))))) (prompt "\nSelected entity must be LWPOLYLINE. Try again...\n") (setq pline (car (entsel "\nSelect Polyline to get an Elevation:"))) ) (setq spt_pline (vlax-curve-getStartPoint pline) ept_pline (vlax-curve-getEndPoint pline) ) (if (> (car spt_pline) (car ept_pline)) (progn (command-s "_reverse" pline "") (setq spt_pline (vlax-curve-getStartPoint pline) ept_pline (vlax-curve-getEndPoint pline) ) ) ) (setq datum_line (car (entsel "\nSelect Datum Line:"))) (while (or (equal datum_line nil) (not (equal "LINE" (cdr (assoc 0 (entget datum_line)))))) (prompt "\nSelected entity must be LINE. Try again...\n") (setq datum_line (car (entsel "\nSelect Datum Line:\n"))) ) (setq yval_datum_line (cadr (vlax-curve-getStartPoint datum_line)) yval_start_pline (- (cadr spt_pline) yval_datum_line) yval_end_pline (- (cadr ept_pline) yval_datum_line) ) (setq txt_position (getpoint "\nPick the lower-left corner of the box for elevation value:\n")) (setvar 'osmode 0) (setq datum_value (car (entsel "\nSelect Datum value:"))) (if (equal "MTEXT" (cdr (assoc 0 (entget datum_value)))) (setq datum_value (LM:UnFormat (cdr (assoc 1 (entget datum_value))) T)) (setq datum_value (cdr (assoc 1 (entget datum_value)))) ) (setq ang_spt_pline (angle (setq yval_position_one (list (car spt_pline) (+ (cadr txt_position) 0.1) (caddr txt_position))) spt_pline) ang_ept_pline (angle (setq yval_position_two (list (car ept_pline) (+ (cadr txt_position) 0.1) (caddr txt_position))) ept_pline) ) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos (+ yval_start_pline (atof datum_value)) 2 3)) (cons 10 yval_position_one) (cons 11 yval_position_one) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_spt_pline))) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos (+ yval_end_pline (atof datum_value)) 2 3)) (cons 10 yval_position_two) (cons 11 yval_position_two) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_ept_pline))) (princ "\nSelect intersecting lines:") (setq intersecting_lines (ssget (list (cons 0 "LINE") (cons 8 "DATUM-GRID"))) len (sslength intersecting_lines) i 0 ) (while (< i len) (setq int_pt_pline (vlax-safearray->list (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object pline) (vlax-ename->vla-object (ssname intersecting_lines i)) acExtendNone))) int_pt_datum_line (vlax-safearray->list (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object datum_line) (vlax-ename->vla-object (ssname intersecting_lines i)) acExtendNone))) dist (distance int_pt_pline int_pt_datum_line) yval_position (list (car int_pt_pline) (+ (cadr txt_position) 0.1) (caddr txt_position)) ang (angle yval_position int_pt_pline) i (1+ i) ) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos (+ dist (atof datum_value)) 2 3)) (cons 10 yval_position) (cons 11 yval_position) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_spt_pline))) ) (setvar 'osmode old_osmode) (prompt "\nAn elevation values were added!") (princ) ) ;;-------------------=={ UnFormat String }==------------------;; ;; ;; ;; Returns a string with all MText formatting codes removed. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; str - String to Process ;; ;; mtx - MText Flag (T if string is for use in MText) ;; ;;------------------------------------------------------------;; ;; Returns: String with formatting codes removed ;; ;;------------------------------------------------------------;; (defun LM:UnFormat ( str mtx / _replace rx ) (vl-load-com) (defun _replace ( new old str ) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new) ) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda ( ) (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '( ("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_replace "\\" "\032" str) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) The short video: YVAL.mp4 Best regards.
    3 points
  2. Another By @Lee Mac Area.lsp look on his web site. https://www.lee-mac.com/arealabel.html
    1 point
  3. Have you defined the variables 'myfilepath' and 'myfilename' somewhere? If not, these symbols will evaluate to nil, yielding the error you have described.
    1 point
  4. Here are two good options from Lee Mac
    1 point
  5. That LISP the is not original AFAIK. It is a couple of functions, you need to call for it with a LISP to make the settings, etc. Several places to get the correct QlSet.lsp and example LISPs to use it. Qleader lisp routine - AutoLISP, Visual LISP & DCL - AutoCAD Forums Qleader System Variables - AutoLISP, Visual LISP & DCL - AutoCAD Forums qleader lisp - AutoLISP, Visual LISP & DCL - AutoCAD Forums assigning q-leader settings using lisp
    1 point
  6. Look for Notepad your Acad.pgp make code even shorter. This the bat file I use. d: cd\alan\lisp findstr %1 *.lsp
    1 point
×
×
  • Create New...