Leaderboard

Command PELP (abbreviation of your title (kind of)) (vl-load-com) ;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/ (defun drawPoint (pt) (entmakex (list (cons 0 "POINT") (cons 10 pt)))) (defun c:pelp ( / ss i pt ent) (setq ss (ssget (list (cons 0 "LINE,POLYLINE,LWPOLYLINE")))) (setq i 0) (repeat (sslength ss) (setq ent (ssname ss i)) ;; start point (setq pt (vlax-curve-getStartPoint (vlax-ename->vla-object ent))) (drawPoint pt) ;; end point (setq pt (vlax-curve-getEndPoint (vlax-ename->vla-object ent))) (drawPoint pt) (setq i (+ i 1)) ) )

For me when in doubt just use cons for everything. (setq pre_blk (ssget "_X" (list (cons -4 "=,=,=") (cons 10 pre_vtx)(cons 0 "INSERT"))))

-EDIT- I was going at this the other way to Mhupp, get the information from the dimension and them make new text, many ways to do the same thing- You can get the text itself if you use (setq MyDim (entget (car (entsel "Select Dimension")))) which gives an associated list of the dimension entity stuff. In this list number 1 gives Text Override value and 42 gives the measured value (setq TextOverride (cdr (assoc 1 MyDim))) (setq MyDimValue (cdr (assoc 42 MyDim))) you might have to decide if you need to use text override values or just the measured dimension, and note here that if the text override text contains <> this means it will show the measured dimension there... so will need to take into account that as well. I think there is a chance that in a very very long text override code 304 will take any overspill from code 1.. but I'd be surprised if you need to consider that (also 172 and 4 but I can't remember why I made a note of them) So onto the text styles, these are not saved in the dimension but in the dimension style and I think you have to do a little more work to get them (setq DimStyleName (cdr (assoc 3 MyDim))) will give you the dim style name and you can do a table search to get the dim style definition: (setq DimstyleDefinition (tblsearch "DIMSTYLE" DimStyleName)) However I will have to come back to this to get the next part for you - should be sometihng there for you to think about and start you off making something up, at least getting the text to start with --EDIT-- This will give you the text style name, though this is for the dimension style used and not any over ride the user might change to (setq DimTxtEntity (entget (cdr (assoc 340 DimstyleDefinition))) ) (setq DimTxtStyle (cdr (assoc 2 DimTxtEntity)))

This is the quick and dirty version. no error handling. Copies the whole dimension to the new location. Explodes the copied dimension Erases everything but the MTEXT Explodes Mtext into text don't know if it keeps its style? seems to. ;;----------------------------------------------------------------------------;; ;; Copy dimension value to another location (defun C:DimCopy (/ dim BP LastEnt en) (vl-load-com) (while (setq dim (car (entsel "\nSelect Dimension: "))) (setq dim (vlax-ename->vla-object dim)) (setq BP (vlax-get dim 'TextPosition)) (setq LastEnt (entlast)) (setq copy (vla-copy dim)) (vla-move copy BP (getpoint BP "\nCopy locaiton")) (command "_Explode" (entlast)) (if (setq en (entnext LastEnt)) (while en (cond ((= "MTEXT" (cdr (assoc 0 (entget en)))) (command "_Explode" en) ;convert mtext to text ) ((= "TEXT" (cdr (assoc 0 (entget en)))) (progn) ) (t (entdel en) ) ) (setq en (entnext en)) ) ) ) (princ) )

If you load the lisp at startup (via the start-up suit) then I think the simplest way is to put the line (c:foo) after the lisp routine - once it is loaded it runs, but if you later delete the lisp or whatever you don't need to worry about much more You can also search for acad.lsp file and put the same line in there (search online how to do that if you need to). (I am always a little paranoid about order things load at start up, whether acad.lsp loads before or after a LISP routine - if it is before it tries to run something that isn't loaded and will just move on without it - what you think it has done hasn't and that's another reason I prefer the first option)

Another way just build the list of points. Then sort for unique points then mass create whats left. ;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/ (defun drawPoint (pt) (entmakex (list '(0 . "POINT") (cons 10 pt) ) ) ) (defun c:pelp ( / ss pt ent pt-lst) (setq ss (ssget '((0 . "LINE,POLYLINE,LWPOLYLINE")))) (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (setq pt-lst (cons (vlax-curve-getStartPoint (vlax-ename->vla-object ent)) pt-lst)) (setq pt-lst (cons (vlax-curve-getEndPoint (vlax-ename->vla-object ent)) pt-lst)) ) (setq pt-lst (LM:Unique pt-lst)) (foreach pt pt-lst (drawPoint pt) ) (princ) ) ;; Unique - Lee Mac ;; Returns a list with duplicate elements removed. (defun LM:Unique ( l ) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))) )

I use Bricscad and Acad so maybe do the set check twice. Sub PTEXT() On Error Resume Next Dim app As Object, Doc As Object On Error Resume Next Set app = GetObject(, "BricscadApp.AcadApplication") 'Checks if BricsCAD is open probably have to change for AutoCAD. If app Is Nothing Then 'Checks if Autocad is open Set App = GetObject(, "AutoCAD.Application") End If If app Is Nothing Then MsgBox "BriscCAD / Autocad isns't Open!", vbCritical, "Output Error" Else: MsgBox "Cad found" Exit Sub End If End Sub app twice

If you want to do Architectural stuff you must have that version. You can only view proxy objects in plain Autocad. But you can maybe open as plain Autocad then add custom menu's that are Architectural commands hopefully, I have done this very successfully in CIV3D having civil commands in the drafting workspace. The more complicated functions still changing to CIV3D workspace.

Added an a to vl-load-com should work now.

I consider it a bug with (command if you input points and yes you can have osmode is set to 0 it will still snap to things if your zoomed out enough. --edit How to store/set multiple variables (setq lst (list 'CMDECHO 'OSMODE 'PICKBOX 'CLAYER) ;built a list of what you want val (mapcar 'getvar lst) ;saves current var of above list ) (mapcar 'setvar lst '(0 5 0 "dims")) ;sets the list of system variables .... (mapcar 'setvar lst val) ;restore origonal values

Worth a shot.

Maybe something like this? (defun f ( l / n r y ) (foreach x l (setq n (if (= "true" (strcase (cadr x) t)) 1 0) x (car x) ) (if (setq y (vl-some '(lambda ( y ) (if (wcmatch x (strcat (car y) "*")) y)) r)) (setq r (subst (list (car y) (+ n (cadr y)) (1+ (caddr y))) y r)) (setq r (cons (list (substr x 1 (vl-string-position 95 x)) n 1.0) r)) ) ) (mapcar '(lambda ( x ) (list (car x) (apply '/ (cdr x)))) r) ) _$ (f lst) (("H603" 0.727273) ("H602" 1.0) ("H601" 1.0))

TRY THIS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Create a rectangle (4 corner points). Draw a midpoint line on the longest side of a rectangle (2 mid points). ;;;; ;;; Create arc lines connecting all 6 points. ;;;; ;;; ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:arctest (/ mylength mywidth oldecho pt1 pt2 pt3 pt4 pt5 pt6 p q pt1x pt1y pt3x pt3y pt1ax pt3ax pt1ay pt3ay ) (vl-load-com) (setq oldecho (getvar 'cmdecho)) (setvar 'cmdecho 0) (setq pt1 (getpoint "\nPick the first point") pt3 (getcorner "\Pick the next corner" pt1) ) (setq pt1x (car pt1)) (setq pt1y (cadr pt1)) (setq pt3x (car pt3)) (setq pt3y (cadr pt3)) (cond ((<= pt1x pt3x) (setq pt1ax pt1x) (setq pt3ax pt3x)) ((> pt1x pt3x) (setq pt1ax pt3x) (setq pt3ax pt1x)) ) (cond ((<= pt1y pt3y) (setq pt1ay pt1y) (setq pt3ay pt3y)) ((> pt1y pt3y) (setq pt1ay pt3y) (setq pt3ay pt1y)) ) (setq pt1 (list pt1ax pt1ay (caddr pt1))) (setq pt3 (list pt3ax pt3ay (caddr pt3))) (vl-cmdf "_.rectang" pt1 pt3) (setq pt2 (vlax-curve-getPointAtParam (entlast) 1) pt4 (vlax-curve-getPointAtParam (entlast) 3) ) (setq delete_rec (cdr(assoc -1(entget (entlast))))) ;Get length and width of rectangle (setq mylength (distance pt1 pt2)); length (setq mywidth (distance pt1 pt4)) ; width ; ; ;Find out which is the shorter side of the rectangle and then draw a line between the midpoints (if (> mywidth mylength); if mywidth is greather than mylength ( if true then...) (progn (setq pt5 (list (/ (+ (car pt1) (car pt4)) 2) (/ (+ (cadr pt1) (cadr pt4)) 2))) (setq pt6 (list (/ (+ (car pt2) (car pt3)) 2) (/ (+ (cadr pt2) (cadr pt3)) 2))) (entmake (list '(0 . "LINE") (cons 10 pt5) (cons 11 pt6) ) ) ;***************************************************************************************************** ;Connect all 6 points ( 4 corners and 2 midpoints) by arc lines ;**************************************************************************************************** ;Vertical arc setup (setq arclines 20) ;; Arc sagitta- midpoint of the chord to the midpoint of the arc (if (and (setq p pt1) (setq q pt3) (mapcar 'set '(p q) (mapcar '(lambda ( x ) (mapcar x p q)) '(min max))) (setq z (trans '(0 0 1) 1 0 t) b (mapcar '(lambda ( a b c ) (/ arclines (- a b) -0.5)) q p '(0 0)) ) ) (entmake (list '(000 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(090 . 6) '(070 . 1) (cons 010 (trans p 1 z)); Pt1 (cons 042 (car b)) (cons 010 (trans (list (car q) (cadr p)) 1 z)); Pt4 (cons 042 (cadr b)) (cons 010 pt6); Pt6: Midpoint on one side (cons 042 (car b)) (cons 010 (trans q 1 z));Pt3 (cons 042 (car b)) (cons 010 (trans (list (car p) (cadr q)) 1 z));Pt2 (cons 042 (cadr b)) (cons 010 pt5);Pt5: Midpoint on the other side (cons 042 (car b)) (cons 210 z) ) ) );END Vertical arc setup (setvar "PLINEWID" 0) );End Progn ; If its not true then... (progn (setq pt5 (list (/ (+ (car pt1) (car pt2)) 2) (/ (+ (cadr pt1) (cadr pt2)) 2))) (setq pt6 (list (/ (+ (car pt3) (car pt4)) 2) (/ (+ (cadr pt3) (cadr pt4)) 2))) (entmake (list '(0 . "LINE") (cons 10 pt5) (cons 11 pt6) ) ) ;***************************************************************************************************** ;Connect all 6 points ( 4 corners and 2 midpoints) by arc lines ;**************************************************************************************************** ;Horizontal arc setup (setq arclines 20) ;; Arc sagitta- midpoint of the chord to the midpoint of the arc (if (and (setq p pt1) (setq q pt3) (mapcar 'set '(p q) (mapcar '(lambda ( x ) (mapcar x p q)) '(min max))) (setq z (trans '(0 0 1) 1 0 t) b (mapcar '(lambda ( a b c ) (/ arclines (- a b) -0.5)) q p '(0 0)) ) ) (entmake (list '(000 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(090 . 6) '(070 . 1) (cons 010 (trans p 1 z)); Pt1 (cons 042 (car b)) (cons 010 pt5); Pt5: Midpoint on one side (cons 042 (car b)) (cons 010 (trans (list (car q) (cadr p)) 1 z)); Pt4 (cons 042 (cadr b)) (cons 010 (trans q 1 z));Pt3 (cons 042 (car b)) (cons 010 pt6);Pt6: Midpoint on the other side (cons 042 (car b)) (cons 010 (trans (list (car p) (cadr q)) 1 z));Pt2 (cons 042 (cadr b)) (cons 210 z) ) ) );END Horizontal arc setup (setvar "PLINEWID" 0) ) ;End Progn ) ;_ if (if (/= delete_rec nil)(command "erase" delete_rec "")) (setvar 'cmdecho oldecho) ); End Program

I was thinking about this, interest for me that was all. I woul;d have worked out all the points in order before the entmake polyline, something like below. This didn't need the temporary rectangle and I have changed the bulge calculation a bit so it works better with small rectangles (still gives odd results if the proportions width - height are very long and narrow) Anyway, I was intrigued how to make it up using my thinking, and pasted below as another example of this ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Create a rectangle (4 corner points). Draw a midpoint line on the longest side of a rectangle (2 mid points). ;;;; ;;; Create arc lines connecting all 6 points. ;;;; ;;; Issue: Arcs not connecting to all 6 points. ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:ArcLines (/ oldecho spt1 spt2 spt3 spt4 scpt1 scpt2 a b c d z) (vl-load-com) (setq oldecho (getvar 'cmdecho)) (setvar 'cmdecho 0) (setq spt1 (getpoint "\nPick the first point") spt3 (getcorner "\Pick the next corner" spt1) a (if (< (car spt1)(car spt3))(car spt1)(car spt3)) ;;Lower Left X coord b (if (> (car spt1)(car spt3))(car spt1)(car spt3)) ;;Upper Right X coord c (if (< (cadr spt1)(cadr spt3))(cadr spt1)(cadr spt3)) ;;Lower Left y Coord d (if (> (cadr spt1)(cadr spt3))(cadr spt1)(cadr spt3)) ;;Upper Right Y Coord z (if (caddr spt1)(caddr spt1) 0) ;;Z Coord ) ;;Make points (if (> (abs (- a b)) (abs (- c d))) ;;IF width > length (progn (setq spt2 (list a c z)) (setq spt3 (list b c z)) (setq spt4 (list b d z)) (setq spt1 (list a d z)) ) ;end progn ;;IF length > width (progn (setq spt1 (list a c z)) (setq spt2 (list b c z)) (setq spt3 (list b d z)) (setq spt4 (list a d z)) );end progn ) ; end if ;;center points (setq scpt1 (list (/ (+ (car spt2) (car spt3)) 2) (/ (+ (cadr spt2) (cadr spt3)) 2)) scpt2 (list (/ (+ (car spt1) (car spt4)) 2) (/ (+ (cadr spt1) (cadr spt4)) 2)) ) ;;Draw Centre Line (entmake (list '(0 . "LINE") (cons 10 scpt1) (cons 11 scpt2) '(8 . "MIDPOINTLINE") ;layer '(62 . 7) ; colour ) ;end list ) ;end entmake (setq arclines ( / (abs (- c d)) 10) ) (if (and (setq b (list (/ arclines (- a b) 0.5) (/ arclines (- c d) 0.5))) ) (entmake (list '(000 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(090 . 6) '(070 . 1) (cons 10 spt1) (cons 42 (car b)) (cons 10 spt2) (cons 42 (car b)) (cons 10 scpt1) (cons 42 (car b)) (cons 10 spt3) (cons 42 (car b)) (cons 10 spt4) (cons 42 (car b)) (cons 10 scpt2) (cons 42 (car b)) (cons 210 (list 0 0 z)) ) ) ) ;END IF (setvar 'cmdecho oldecho) (princ) ); End Program