Leaderboard

Like tombu had signature block insert into all layouts etc .Paper copy was signed legal requirement.

Indeed (entmake) does not work entirely with fields. And you're right about dictionaries, we can do them with entmake, but it's complicated. With (vla-addMtext), it's much simpler, it takes care of the dictionary itself. ((lambda ( / AcDoc Space) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (initget 1) (vla-update (vla-addMtext Space (vlax-3d-point (getpoint "\nInsertion point; ")) 0.0 "%<\\AcVar Filename \\f \"%tc4%fn7\">% %<\\AcVar SaveDate \\f \"MMMM d, yyyy - hh:mm tt\">% %<\\AcVar LastSavedBy \\f \"%tc4\">%" ) ) ))

I often use this helper function below to make it easier to go over a selection set: ;| ; Foreach-ss by dexus ; Loop over every item in a selectionset ; @Param input selection set ; @Param inputfunc function to execute over every item |; (defun foreach-ss (input inputfunc / n) (if (= 'PICKSET (type input)) (repeat (setq n (sslength input)) (inputfunc (ssname input (setq n (1- n)))) ) ) ) Can be used like this: (foreach-ss (ssget) (lambda (e) (princ (cdr (assoc 0 (entget e)))) ) )

Try this: (defun LSTrimToPt ( MyLine TrimPt1 TrimPt2 / MyLineDef MyLineEndA MyLineEndB Pt1Dist Pt2Dist TempPt MyLineA MyLineB currentzoom) (defun breakatpoint (MyEnt point /) (command "_.break" MyEnt "_non" point "_non" point) ) (defun LSZmObj (ss / Minp Maxp lst) ; zooms to an object +area around the end points (foreach Obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (vla-getBoundingBox Obj 'Minp 'Maxp) (setq lst (cons (mapcar 'vlax-safearray->list (list Minp Maxp)) lst))) (vla-ZoomWindow (vlax-get-acad-object) (vlax-3D-point (list (apply 'min (mapcar 'car (mapcar 'car lst))) (apply 'min (mapcar 'cadr (mapcar 'car lst))) 0.0)) (vlax-3D-point (list (apply 'max (mapcar 'car (mapcar 'cadr lst)))(apply 'max (mapcar 'cadr (mapcar 'cadr lst))) 0.0)) ) ) (setq currentzoom (list (getvar 'viewctr) (getvar 'viewsize))) ;; record the current zoom (LSZmObj (ssadd MyLine)) ;; Zoom to show the full line (vla-ZoomScaled (vlax-get-acad-object) 0.95 acZoomScaledRelative) ;; Zoom out a bit (setq MyLineDef (entget MyLine)) ;; Get polyline entity definition (setq MyLineEndA (cdr (assoc 10 MyLineDef))) ;; Get the points of the line (if (= (cdr (assoc 0 MyLineDef)) "LINE") ;; Get end points of line / polyline (setq MyLineEndB (cdr (assoc 11 MyLineDef))) (setq MyLineEndB (cdr (assoc 10 (reverse MyLineDef)))) ) ;;sort trimpts according to distance from end A (setq Pt1Dist (vlax-curve-getdistatpoint (vlax-ename->vla-object MyLine) TrimPt1) ) (setq Pt2Dist (vlax-curve-getdistatpoint (vlax-ename->vla-object MyLine) TrimPt2) ) (if ( > Pt1Dist Pt2Dist) ; swap trim points over (progn (setq TempPt TrimPt1) (setq TrimPt1 TrimPt2) (setq TrimPt2 TempPt) ) ;end progn () ) ;end if (breakatpoint MyLine TrimPt1) ;;"Too many objects for INTERSECT" (setq MyLineA (entlast)) (if (equal MyLineA MyLine 0.0001) (progn ; if end A is trim point (breakatpoint MyLine TrimPt2) ;;"Too many objects for INTERSECT" (setq MyLineB (entlast)) (if (equal MyLineB MyLine 0.0001) ; if end B is trim point () (entdel MyLineB) ) ) (progn (entdel MyLine) (breakatpoint MyLineA TrimPt2) ;;"Too many objects for INTERSECT" (setq MyLineB (entlast)) (if (equal MyLineB MyLineA 0.0001) ; if end B is trim point (progn ) (progn (entdel MyLineB) ) ) ) ) ; end if (vla-ZoomCenter (vlax-get-acad-object) (vlax-3d-point (car currentzoom)) (cadr currentzoom)) MyLineA ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:test ( / Route TrimmedRoute PtA PtB) (setq Route (car (entsel "Select Line / PolyLine"))) (setq PtA (getpoint "Select trim point 1")) (setq PtB (getpoint "Select trim point 2")) (setq TrimmedRoute (entmakex (entget Route))) ; Copy route (setq TrimmedRoute (LSTrimToPt TrimmedRoute PtA PtB)) )

Here's another one I've had around for a while modified to get the transparency too. It's also good to exclude items that already contain the suffix so you don't end up with duplicate suffixes. (defun c:layersuffix (/ a el f l nl s tm) ;; RJP - 04.03.2018 (or (setq f (getenv "RJP_LayerSuffix")) (setq f (strcat "-" (getenv "username")))) (cond ((and (setq f (cond ((/= "" (setq tm (getstring (strcat "\nEnter suffix [<" f ">]: ")))) tm) (f) ) ) (setq s (ssget ":L" (list '(-4 . "<NOT") (cons 8 (strcat "*" f)) '(-4 . "NOT>")))) ) (setenv "RJP_LayerSuffix" f) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (setq el (entget (setq a (tblobjname "layer" (setq l (cdr (assoc 8 (entget e)))))))) (setq a (getpropertyvalue a "Transparency")) (if (not (tblobjname "layer" (setq nl (strcat l f)))) (progn (setq el (entmakex (subst (cons 2 nl) (assoc 2 el) el))) (setpropertyvalue el "Transparency" a) ) ) (entmod (subst (cons 8 nl) (assoc 8 (entget e)) (entget e))) ) ) ) (princ) )

@pkenewell The change you proposed seems like a great code optimization. The "vl-remove-if function" is specific to removing items from a list based on a condition, which makes it a better choice for this particular case. This approach can also improve code performance in cases of large data sets, as it is more efficient than manually iterating over each list item. I just started with something to try and you make it better

@enthralled A little trickier with getting and setting transparency - but almost all can be done fairly easily with Visual LISP Activex functions. ;; New version by Pkenewell. Uses Visual LISP & ActiveX (defun C:CNL ( / acdoc cnt el la llst lt lw lyrs np nl ss su tr) (vl-load-com) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) lyrs (vla-get-layers acdoc) ) (vla-StartUndoMark AcDoc) (if (and (setq ss (ssget ":L")) (setq su (getstring T "\nEnter suffix for new layers for selected objects: ")) ) (progn (repeat (setq cnt (sslength ss)) (setq el (entget (ssname ss (setq cnt (1- cnt)))) la (cdr (assoc 8 el)) ) (if (not (member la llst))(setq llst (cons la llst))) ) (foreach n llst (setq ob (vlax-ename->vla-object (setq el (tblobjname "LAYER" n))) col (vla-get-truecolor ob) lt (vla-get-linetype ob) lw (vla-get-lineweight ob) np (vla-get-plottable ob) tr (getpropertyvalue el "Transparency") nl (vla-add lyrs (strcat (vla-get-name ob) su)) ) (vla-put-truecolor nl col) (vla-put-linetype nl lt) (vla-put-lineweight nl lw) (vla-put-plottable nl np) (setpropertyvalue (vlax-vla-object->ename ob) "Transparency" tr) ) ) ) (vla-EndUndoMark AcDoc) (princ) )

"Can this code be updated to export the text coordinates, Value and layers to excel?" YES but new code. Can send direct to excel. Last number can be found by searching text and checking its value, > oldtext newtext, so save highest value as a number. I just wonder why a point manager Hint Lee-Mac, was not used in 1st place if these are imported points. Or if they have been manually added why not use a block with POINT & 1 Attribute. Much easier to handle than plain text. Please respond about where points are coming from. Have a couple of off the shelf solutions.

I have done something similar where you select block and its tag and current value are displayed in a dcl so you edit and it makes a list of all attributes, the update of the block ignores tag names rather updates based on attribute order so actually updates all attributes. The dcl code uses my Multi getvals.lsp so that is done. As you want to do multi dwg it needs to be a 2 step process select block and do edits then save in say a file, then run across multiple dwg's reading the file for values. Going further blank out values then can set those to not update they have a value of "". This example is pushing the screen size as it has 25 attributes. You just edit the attribute values. (defun getatttagnames (obj / ) (setq lst '()) (setq atts (vlax-invoke obj 'getattributes)) (foreach att atts (setq lst (append (list (vla-get-textstring att) 29 30 (vla-get-tagstring att) ) lst) ) ) ) (defun wow ( / ss lst obj att atts str) (setq ss (ssget "x" '((0 . "INSERT")(2 . "EPCB000")))) (setq obj (vlax-ename->vla-object (ssname ss 0))) (getatttagnames obj) (setq lst (reverse lst)) (setq lst (cons "Please edit" lst)) (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (setq ans (AH:getvalsm lst)) (setq x -1) (foreach att atts (setq str (nth (setq x (1+ x)) ans)) (if (= str "") (princ) (vla-put-textstring att str) ) ) (princ) ) (wow) PS there is a line spacer in the dcl code so I think somewhere did a version when you have lots of rows it is left out. Line 33 in multi getvals. Multi GETVALS.lsp

you mean texts with numbers? Try this, one "#" is for one number (ssget '((0 . "MTEXT")(1 . "#,##,###")))

Try this ; Put number at 1/2 internal angle ; By AlanH May 2024 (defun c:labmid ( / oldsnap dist p1 p2 p3 p4 ang1 ang2 ang3) (setq x 1) ;; Get Inside Angle - Lee Mac ;; Returns the smaller angle subtended by three points with vertex at p2 (defun LM:GetInsideAngle ( p1 p2 p3 ) ( (lambda ( a ) (min a (- (+ pi pi) a))) (rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi)) ) ) ; clockwise check by G Carlo (defun gc:clockwise-p ( p1 p2 p3 ) (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14)) (setq oldsnap (getvar 'osmode)) (setq dist (getreal "\nEnter radial distance from corner ")) (setvar 'osmode 35) (while (setq p1 (getpoint "\nPick 1st point away from intersection Enter to exit ")) (setvar 'osmode 32) (setq p2 (getpoint "\nPick point at intersection ")) (setvar 'osmode 35) (setq p3 (getpoint "\nPick 3rd point away from intersection ")) (setq ang3 (/ (LM:GetInsideAngle p1 p2 p3 ) 2.0)) (setq ang1 (angle p1 p2)) (if (gc:clockwise-p p1 p2 p3 ) (setq p4 (polar p2 (+ ang1 ang3 pi) dist)) (setq p4 (polar p2 (- ang1 ang3 pi) dist)) ) (setvar 'osmode 0) (command "text" p4 1.0 0.0 (rtos X 2 0)) (setq x (1+ x)) (setvar 'osmode 35) ) (setvar 'osmode oldsnap) (princ) ) (c:labmid)

A good tutorial and description about using XDATA. https://www.afralisp.net/autolisp/tutorials/extended-entity-data-part-1.php

There aren't really many applications in which you would use xdata. I can only imagine needing one when you create your own applications like you would with a dictionary, in which you would like the objects to behave and "react" differently in respond to several commands. Again, what do I know... Here is one example of one of my programs in which xdata is used. (I hardly ever use this because I hardly see its use, but I just created it as practice for myself. Hence, I stopped enhancing it.) Edit: Apologies for the complex example, I didn't read the OP that it was intended to be simple... ObjectPropertySync.lsp

I did this, but tested superficially. I hope it does what you want! Cut_Poly3D.lsp

I'll assume from your question that it is all loaded (if not this is good resource: https://lee-mac.com/runlisp.html), To run a loaded LISP generally all you need to do is type function name so long as it starts with a c:, (ignore the c:) the function names come after "defun". In the examples above I think the program is (defun c:populate.... and you'll want to type in populate If the function name doesn't have 'c:' then to get that part to run generally put the function name in brackets ( -functionaname- ) Hope this help else you might need to list what you are doing, probably missed a very silly thing - easy to do

I am trying to pull a cross shaped region up to a slanted mounting brace, but when I do it, it won't stop along the slant. It protrudes through and beyond the solid brace. I tried moving my UCS to the top of the line aligned with the slanted solid on the top. Any suggestions? Thanks presspull1.dwg

Been adding a security check to code for years since "Protect" existed like 30 years ago, like others can use "_PKSER" returns Cad serial number, also yes I know it does work stopped an install by some one not wanting to pay. For us oldies using a DOS command ie CMD in windows you can copy a security lisp to every lisp program that you want then run another lisp that makes all of them into FAS, just done for like 30 lisps for a client. Protecting his investment not mine. The DOS command is as next you need a bat file to do it for all the files COPY D:\mylisps\securty.lsp+D:\mylisps\mylisp1.lsp D:\newfolder\mylisp1.lsp repeat for all lisps Compile 2 examples (defun comp ( ) (if (null vlisp-compile) (c:vlide T)) (setq fname (getfiled "Pick lisp to be compiled" "D:\\alan\\lisp" "lsp" 8)) (setq len (strlen fname)) (setq diff (- len (+ 15 3))) (setq fnameout (substr fname 15 diff)) (vlisp-compile 'st fname (strcat "d:\\alan\\compiled\\" fnameout ".fas")) ) (comp) ; part 2 ; must have vlide open to work (vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) "Vlide ") (setq loads (list ; make a list of all lsp files. "mylisp1" "mylisp2" )) (setq loc1 "C:\\CAD-TOOLS") ;;change dirs to where ever you want them found (setq loc2 "C:\\CAD-TOOLS\\") ;;change dirs to where ever you want them saved (foreach lisp loads (vlisp-compile 'st (strcat loc1 lisp ".lsp") (strcat loc2 lisp ".fas")) ) For BRICSCAD users just change to BLADE and DES. So as mentioned some security checks Hard disk id Cad serial number Set & Getenv registry check Network card IP address Ping remote server and check in a file User name

"Joining circles via creation order", using ssget can most times do this, try it, but as was posted somewhere else doing a sort on the "Handle ID" of the objects is creation order. I seem to remember must change to a number not hex. Quick and dirty (defun wow ( / ss x) (setq ss (ssget '((0 . "CIRCLE")))) (command "pline") (repeat (setq x (sslength ss)) (command (cdr (assoc 10 (entget (ssname ss (setq x (1- x))))))) ) (command "") ) (wow)

For poly lines you can get angle at a point on a pline. Note Vl object. (defun alg-ang (obj pnt) (angle '(0. 0. 0.) (vlax-curve-getfirstderiv obj (vlax-curve-getparamatpoint obj pnt ) ) ) )

Just pointing out how complex the code could be when you could simply use snap from the vertex to midpoint between those two endpoints for the direction. AutoCAD - Snap From - https://www.google.com/search?q=autocad+snap+from&rlz=1C1RXQR_enUS986US986&oq=autocad+snap+from&gs_lcrp=EgZjaHJvbWUqBwgAEAAYgAQyBwgAEAAYgAQyCAgBEAAYFhgeMggIAhAAGBYYHjIICAMQABgWGB4yCAgEEAAYFhgeMggIBRAAGBYYHjIICAYQABgWGB4yCAgHEAAYFhgeMggICBAAGBYYHjIICAkQABgWGB7SAQkxMjUxMWowajeoAgCwAgA&sourceid=chrome&ie=UTF-8#fpstate=ive&vld=cid:15476a18,vid:gbWQ8Gh0r9Q,st:0

Thank you so much you are still helping people in 2024.

XData is essentially an additional bit of information added to the entity definition, it doesn't change how the entity is shown on the screen. What you want to do can be done, and this link is a good description https://www.afralisp.net/autolisp/tutorials/extended-entity-data-part-1.php

Easiest to code would include picking the vertex and the two endpoints. For bisecting using lines and polylines see: http://www.cadtutor.net/forum/showthread.php?100709-Draw-bisector-line&p=684958&viewfull=1#post684958

Use (princ (strcat "\n" stringa)) will princ on a new line.

Something like this? ;; For polylines ONLY. Points returned in WCS (defun foo (ent / d dis i m pm p) (setq i 0 p 0.0 m (vlax-curve-getdistatparam ent 1)) (while (setq i (1+ i) d (vlax-curve-getdistatparam ent i)) (and (<= (setq dis (- d p)) m) (setq m dis pm (1- i))) (setq p d) ) (list (vlax-curve-getpointatparam ent pm) ; Start Vertex (vlax-curve-getpointatparam ent (1+ pm)) ; End Vertex (vlax-curve-getpointatparam ent (setq pm (+ 0.5 pm))) ; Mid Vertex (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent pm)) ; Angle at mid vertex ) )

Is this for work or just something you want to learn and do as a hobby/side gig?

There is a free version of nanoCAD. Note: it is 2D only.

Autodesk Education & Student Access | Autodesk You can pay by the month and first 30 days is a free trial. There are cheaper alternatives to AutoCAD, like BricsCAD.

[XDrX-PlugIn(159)] Create snake line over a circle (theswamp.org) https://www.theswamp.org/index.php?topic=59526.0 (defun c:xdtb_snakecircle (/ an box cir direc dist e1 e2 endln ents ents-pair ept1 ept2 firstln garc i ints items ln1 ln2 mode p1extend pl ptmid pts1 pts2 spt1 spt2 x y ) (defun _make-sharp-corners (direc) (setq items (nth direc ents-pair) e1 (car items) e2 (cadr items) ept2 (xdrx-curve-getendpoint e2) spt2 (xdrx-curve-getstartpoint e2) spt1 (xdrx-curve-getstartpoint e1) ept1 (xdrx-curve-getendpoint e1) ) (cond ((= (rem direc 2) 0) (if (< direc (/ #xd-var-global-divide-nums 2.0)) (progn (setq p1extend (xdrx-getpropertyvalue (list spt1 ept1) "getclosestpointto" ept2 t ) ptmid (xdrx-line-midp ept2 p1extend) ) (xdrx-curve-setsptept e1 ept1 p1extend) (if (= #xd-var-global-mode "1") (progn (setq ptmid (polar ptmid 0 (distance ptmid ept2))) (setq garc (xdge::constructor "kCircArc3d" p1extend ptmid ept2 ) ) (xdrx-entity-make garc) ) (progn (setq ptmid (polar ptmid 0 (* (distance ptmid ept2) 1.3))) (xdrx-line-make p1extend ptmid) (xdrx-line-make ptmid ept2) ) ) ) (progn (setq p1extend (xdrx-getpropertyvalue (list spt2 ept2) "getclosestpointto" ept1 t ) ptmid (xdrx-line-midp ept1 p1extend) ) (xdrx-curve-setsptept e2 ept2 p1extend) (if (= #xd-var-global-mode "1") (progn (setq ptmid (polar ptmid 0 (distance ptmid ept1))) (setq garc (xdge::constructor "kCircArc3d" p1extend ptmid ept1 ) ) (xdrx-entity-make garc) ) (progn (setq ptmid (polar ptmid 0 (* (distance ptmid ept1) 1.3))) (xdrx-line-make ept1 ptmid) (xdrx-line-make ptmid p1extend) ) ) ) ) ) (t (if (< direc (/ #xd-var-global-divide-nums 2.0)) (progn (setq p1extend (xdrx-getpropertyvalue (list spt1 ept1) "getclosestpointto" spt2 t ) ptmid (xdrx-line-midp spt2 p1extend) ) (xdrx-curve-setsptept e1 spt1 p1extend) (if (= #xd-var-global-mode "1") (progn (setq ptmid (polar ptmid pi (distance ptmid spt2))) (setq garc (xdge::constructor "kCircArc3d" p1extend ptmid spt2 ) ) (xdrx-entity-make garc) ) (progn (setq ptmid (polar ptmid pi (* (distance ptmid spt2) 1.3))) (xdrx-line-make p1extend ptmid) (xdrx-line-make ptmid spt2) ) ) ) (progn (setq p1extend (xdrx-getpropertyvalue (list spt2 ept2) "getclosestpointto" spt1 t ) ptmid (xdrx-line-midp spt1 p1extend) ) (xdrx-curve-setsptept e2 spt2 p1extend) (if (= #xd-var-global-mode "1") (progn (setq ptmid (polar ptmid pi (distance ptmid spt1))) (setq garc (xdge::constructor "kCircArc3d" p1extend ptmid spt1 ) ) (xdrx-entity-make garc) ) (progn (setq ptmid (polar ptmid pi (* (distance ptmid spt1) 1.3))) (xdrx-line-make spt1 ptmid) (xdrx-line-make ptmid p1extend) ) ) ) ) ) ) ) (setq #xd-var-global-mode "0") (xdrx-initget 0 "0 1") (if (setq mode (getkword (xdrx-string-formatex (xdrx-string-multilanguage "\n模式[标准(0)/圆弧(1)]<1>" "\nMode[standard(0)/arc(1)]<%s>") #xd-var-global-mode ) ) ) (setq #xd-var-global-mode mode) ) (xdrx-initget) (xd::doc:getint (xdrx-string-multilanguage "\n等分数" "\nDivide Nums") "#xd-var-global-divide-nums" 20 ) (if (setq cir (car (xdrx-entsel (xdrx-string-multilanguage "\n拾取圆<退出>:" "\nPick Circle<Exit>:") '((0 . "circle")) ) ) ) (progn (xdrx-begin) (xdrx-setmark) (setq box (xdrx-entity-box cir) ln1 (list (nth 3 box) (nth 0 box)) pts1 (xdrx-getpropertyvalue ln1 "getsamplepoints" #xd-var-global-divide-nums ) ln2 (list (nth 2 box) (nth 1 box)) pts2 (xdrx-getpropertyvalue ln2 "getsamplepoints" #xd-var-global-divide-nums ) an (angle (car pts2) (car pts1)) firstln (list (polar (car pts1) an (/ (distance (car pts1) (car pts2) ) 7.0 ) ) (car pts2) ) an (angle (car pts1) (car pts2)) dist (/ (distance (last pts1) (last pts2)) 7.0) endln (if (= (rem #xd-var-global-divide-nums 2) 1) (list (polar (last pts1) (+ an pi) dist) (last pts2)) (list (last pts1) (polar (last pts2) an dist)) ) pts1 (cdr (xd::list:removetail pts1)) pts2 (cdr (xd::list:removetail pts2)) ents nil ) (xdrx-line-make firstln) (setq ents (cons (entlast) ents)) (mapcar '(lambda (x y) (setq ints (xdrx-entity-intersectwith (list x y) cir) ints (xdrx-points-sortoncurve (list x y) ints) ) (apply 'xdrx-line-make ints ) (setq ents (cons (entlast) ents)) ) pts1 pts2 ) (xdrx-line-make endln) (setq ents (cons (entlast) ents) ents (reverse ents) ents-pair (xd::list:snakepair ents) ) (setq i -1) (repeat (length ents-pair) (setq i (1+ i)) (_make-sharp-corners i) ) (xdrx-curve-join (xdrx-getss)) (setq pl (entlast)) (xdrx-entity-setcolor pl 1) (xdrx-end) ) ) (princ) ) ===================== The above code uses XDrx API, download link: https://github.com/xdcad/XDrx-API-zip https://sourceforge.net/projects/xdrx-api-zip/ Dual version link: https://github.com/xdcad

I think its making contour labels this is a copy of the method inside CIV3D. Did something 30 years ago the fence works out the intersection with the contour and gets Z. No idea where to find it. If we go back even further in time a non ACAD civil software just auto labelled the contour RL based on a spacing factor. Way simpler than using fence.

I added drawing file path, save date and saved by to custom properties in my template files placing them in all our title blocks so they're displayed on every layout on all our drawings automatically. I added drop-downs in Properties tab for setting custom properties like picking the engineer for the signature block or entering the field book number for the survey notes.

The issue maybe is that you have 2 variables Savedate and Lastsavedby when you close the dwg these will probably disappear, so no update, I have started using this for saving info in a dwg, rather than variables 1-5, Userr1, Useri1, Users1. (vlax-ldata-put "StevenP" "SAVEDATE" yourdate ) (setq savedate (vlax-ldata-get "StevenP" "SAVEDATE"))

First impressions: Obviously there's a lot going on here. I don't consider myself an expert on AutoLISP, but I've dabbled in many languages. Anyone remember SNOBOL? APL? AutoLISP is not case sensitive, but using "Com" and "com" could confuse the casual reader (such as myself). Not only that, COM is the Component Object Model, which is a Microsoft thing you can use with AutoLISP; if that variable has nothing to do with COM, I'd use something else (again to avoid confusion). You can overload functions in AutoLISP, but I think you have to use different argument lists. Since there are two definitions of FAS here with the same argument list, the first one will be ignored. Since the code is different, I'm not sure which one to discuss. I have not seen the command-s keyword before. Interesting. Wouldn't (logand 1 (getvar 'CMDACTIVE)) be equivalent to (eq (logand 1 (getvar 'CMDACTIVE)) 1)? Wait, no it isn't. This is the kind of thing that trips me up. Welcome to the forum! A better programmer will be along shortly to help you.

I can't quite see what it is doing exactly from the video, however it looks like a ssget function with a selection mode, fence, crossing polygon or window ( https://lee-mac.com/ssget.html ). Do you select the points as you move the mouse over the text rather then using a straight line - sort of wave the mouse around the screen and select it all that way? That could be interesting but complicated - using gread (which the documentation says is an advanced method and rarely needed). Might be worth reading about and can be interesting when you work it out: gread to get the mouse location, using its position to select entities as it passes over them. On selection 'redraw' to highlight the entity and add to a selection set, to do that on the fly and highlight the entities. You could just use gread to create a polygon fence / crossing polygon, hit enter and then use ssget to select all the text within that area which is a bit simpler. If someone has the time that look like an interesting problem So 3 options: ssget and fence based on the start and end points of the mouse based on clicks ssget and fence based on the path the mouse takes using gread to capture the points it moves along to create the fence 'on the fly' using gread and points underneath as you go (I'd have to think about the method for that one but sounds most fun (?)

Thanks for the generous offer... but: I glad to help, Duke! That's the reason we are here: to get and to offer help. If you like our forum, hang on here, get yourself involved in discussions, offer your advice to novice users. I wish you a nice day!

This is what I have, basically the same thing posted. (vlax-invoke (vlax-get (vlax-get (setq html (vlax-create-object "htmlfile")) 'ParentWindow) 'ClipBoardData) 'setData "Text" sText) (vlax-release-object html) ;release the html bad things could happen another backwards way to do it if the htmlfile still isn't working for you. Run a power shell to create a text file and output the clipboard with Get-Clipboard to a text file then just read the text file.

I was thinking... This code from @Steven P is also good... I just took some spare time to mod. it to suit my needs... Carefully read (alert) comment and you are ready to go testing it... All the best to author and others reading post... (defun c:PlPath-single ( / *error* LSTrimToPt cmd osm ss Route rx uf TrimmedRoute PtA PtB ) (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com)) (defun *error* ( m ) (if uf (if command-s (command-s "_.ucs" "_p") (vl-cmdf "_.ucs" "_p") ) ) (if (= 8 (logand 8 (getvar (quote undoctl)))) (if command-s (command-s "_.undo" "_e") (vl-cmdf "_.undo" "_e") ) ) (if osm (setvar (quote osmode) osm) ) (if cmd (setvar (quote cmdecho) cmd) ) (if m (prompt m) ) (princ) ) (defun LSTrimToPt ( MyLine TrimPt1 TrimPt2 / Pt1Dist Pt2Dist TempPt MyLineA MyLineB ) (defun breakatpoint ( MyEnt point ) (command "_.break" MyEnt "_non" point "_non" point) ) (if command-s (command-s "_.zoom" "_ob" MyLine "") (vl-cmdf "_.zoom" "_ob" MyLine "") ) (vla-ZoomScaled (vlax-get-acad-object) 0.95 acZoomScaledRelative) ;; Zoom out a bit ;;sort trimpts according to distance from end A (setq Pt1Dist (vlax-curve-getdistatpoint MyLine TrimPt1)) (setq Pt2Dist (vlax-curve-getdistatpoint MyLine TrimPt2)) (if (> Pt1Dist Pt2Dist) ; swap trim points over (progn (setq TempPt TrimPt1) (setq TrimPt1 TrimPt2) (setq TrimPt2 TempPt) ) ;end progn ) ;end if (breakatpoint MyLine (trans TrimPt1 0 1)) (setq MyLineA (entlast)) (if (equal MyLineA MyLine 0.0001) (progn ; if end A is trim point (breakatpoint MyLine (trans TrimPt2 0 1)) (setq MyLineB (entlast)) (if (not (equal MyLineB MyLine 0.0001)) ; if end B is trim point (entdel MyLineB) ) ) (progn (entdel MyLine) (breakatpoint MyLineA (trans TrimPt2 0 1)) (setq MyLineB (entlast)) (if (not (equal MyLineB MyLineA 0.0001)) ; if end B is trim point (entdel MyLineB) ) ) ) ; end if MyLineA ) (alert "If you want trimming on opposite side, you should change initial vertex of LWPOLYLINE (if your reference object is LWPOLYLINE) - use (c:chiv) if you have it loaded...") (setq cmd (getvar (quote cmdecho))) (setvar (quote cmdecho) 0) (setq osm (getvar (quote osmode))) (setvar (quote osmode) 545) (if (= 8 (logand 8 (getvar (quote undoctl)))) (if command-s (command-s "_.undo" "_e") (vl-cmdf "_.undo" "_e") ) ) (if command-s (command-s "_.undo" "_m") (vl-cmdf "_.undo" "_m") ) (prompt "Select Line / PolyLine / Spline / HELIX on unlocked layer...") (if (setq ss (ssget "_+.:E:S:L" (list (cons 0 "*POLYLINE,SPLINE,HELIX,LINE")))) (progn (setq Route (ssname ss 0)) (if (or (if (assoc 210 (setq rx (entget Route))) (not (equal (cdr (assoc 210 rx)) (list 0.0 0.0 1.0) 1e-6)) ) (if (assoc 38 rx) (not (zerop (cdr (assoc 38 rx)))) ) ) (progn (if command-s (command-s "_.ucs" "_ob" Route) (vl-cmdf "_.ucs" "_ob" Route) ) (setq uf t) ) (if (= 0 (getvar (quote worlducs))) (progn (if command-s (command-s "_.ucs" "_w") (vl-cmdf "_.ucs" "_w") ) (setq uf t) ) ) ) (setq PtA (getpoint "Select Start point : ")) (setq PtB (getpoint PtA "Select End point : ")) (if (= 0 (getvar (quote worlducs))) (progn (setq PtA (trans PtA 1 0)) (setq PtB (trans PtB 1 0)) ) ) (setq TrimmedRoute (entmakex rx)) ; Copy route (setq TrimmedRoute (LSTrimToPt TrimmedRoute PtA PtB)) (repeat 2 (if command-s (command-s "_.zoom" "_p") (vl-cmdf "_.zoom" "_p") ) ) (if command-s (command-s "_.draworder" (ssadd TrimmedRoute) "" "_f") (vl-cmdf "_.draworder" (ssadd TrimmedRoute) "" "_f") ) ) ) (*error* nil) ) HTH. Regards, M.R.

You can create a text object with one command. If you want a multiline text, you have to do some work, but you get more control. Look into the DXF codes. You can create a multitext with the entmake command using a list of these codes in this order: Entity Type - (0 . "MTEXT") Object Type - (100 . "AcDbEntity") Layer - (8 . <layer name>) Object Subtype - (100 . "AcDbMText") Location - (10 . <point>) Direction of UCS - (11 . (getvar 'ucsxdir)) Translation Matrix - (210 . '(0 0 1) 1 0 T) Text Height - (40 . <height>) Justification - (71 . <insertion point, see below>) Contents - (1 . <text>) Style - (7 . <style>) Rotation - (50 . <angle in radians>) Fill - (90 . <code, see below>) Background Color (pick one) - (63 . <color index>) / (420-429 . <RGB color>) / (430 . <color name>) Fill Box Scale (optional) - (45 . <margin>) Transparency - (441 . 0) Some notes: The Justification value is an integer: 1=top left, 2=top center, 3=top right, 4=middle left, etc. You can omit the Style code, it will default to Standard. The Fill code is the sum of these integers: 0=none, 1=background, 2=drawing window color. For the multileader options, here's another set of codes. I haven't had time to figure out exactly how these work. I know, it's a lot of information. If you have questions, post a response.

I thought i did an edit on the code yes should be I just me I use X all the time.

Just a question why are they wrong ? Going back a step how is leader made & how is text made. Does not make much sense that its being done incorrectly. Sounds like its sloppy drafting.

"i" is correct

(defun c:randlstcolcurv ( / *error* LM:randrange LM:rand cad doc alo spc collst sel i e o col ) (or (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil)) (vl-load-com)) (defun *error* ( m ) (while (= 8 (logand 8 (getvar (quote undoctl)))) (if doc (vla-endundomark doc) ) ) (if doc (vla-regen doc acactiveviewport) ) (if m (prompt m) ) (princ) ) ;; Random in Range - Lee Mac ;; Returns a pseudo-random integral number in a given range (inclusive) (defun LM:randrange ( a b ) (+ (min a b) (fix (* (LM:rand) (1+ (abs (- a b)))))) ) ;; Rand - Lee Mac ;; PRNG implementing a linear congruential generator with ;; parameters derived from the book 'Numerical Recipes' (defun LM:rand ( / a c m ) (setq m 4294967296.0 a 1664525.0 c 1013904223.0 $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m) ) (/ $xn m) ) (or cad (setq cad (vlax-get-acad-object))) (or doc (setq doc (vla-get-activedocument cad))) (or alo (setq alo (vla-get-activelayout doc))) (or spc (setq spc (vla-get-block alo))) (if doc (vla-startundomark doc) ) (setq collst (list 1 5 8 9 15 25 31 24 52 64 85 93 72)) ;;; edit to suit your needs ;;; (if (setq sel (ssget (list (cons 0 "*LINE")))) (repeat (setq i (sslength sel)) (setq e (ssname sel (setq i (1- i)))) (setq o (vlax-ename->vla-object e)) (if (vlax-property-available-p o "Color" T) (progn (setq col (nth (LM:randrange 0 (1- (length collst))) collst)) (vlax-put-property o (quote color) col) ) ) ) ) (*error* nil) ) HTH. M.R.

Another way is to use foreach. (setq blks (list "SW1FRM" "SW1PNL" "EW1FRM" "EW1PNL")) (foreach blk blks (if (tblsearch "BLOCK" blk) (if (tblsearch "BLOCK" "MBS_TABLES.dwg") (princ "exists") (command "-INSERT" "MBS_TABLES.dwg" "0,-50" txthtscld "0") ) ) )

Here's another - (defun c:brace ( / ang blg di1 di2 mat rad pt1 pt2 ) (setq rad 1.0) ;; Brace radius (if (and (setq pt1 (getpoint "\nSpecify 1st point for brace: ")) (progn (while (and (setq pt2 (getpoint "\nSpecify 2nd point for brace: " pt1)) (< (distance pt1 pt2) (* 4 rad)) ) (princ "\nDistance between the two points must be greater than 4 times the radius.") ) pt2 ) ) (progn (setq di1 (distance pt1 pt2) di2 (- (/ di1 2.0) rad) ang (angle pt1 pt2) mat (list (list (cos ang) (- (sin ang))) (list (sin ang) (cos ang))) blg (1- (sqrt 2.0)) ) (entmake (append '( (000 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (090 . 7) (070 . 0) ) (apply 'append (mapcar (function (lambda ( a b ) (list (cons 010 (mapcar '+ (mapcar '(lambda ( r ) (apply '+ (mapcar '* r a))) mat) pt1)) (cons 042 b) ) ) ) (list '(0.0 0.0) (list rad (- rad)) (list di2 (- rad)) (list (+ di2 rad) (- 0 rad rad)) (list (- di1 di2) (- rad)) (list (- di1 rad) (- rad)) (list di1 0.0) ) (list blg 0.0 (- blg) (- blg) 0.0 blg 0.0) ) ) (list (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))) ) ) ) ) (princ) ) To flip the brace, pick the points in the opposite direction.

I just tried something, I think it works pretty well. What the script did: it picks a point within a rectangle/box. If that point is not inside the polyline (which can have a weird shape) that point is skipped. and the while-loop tries again. Eventually a point will be found. I added a "not_too_close" condition to the if (in the while). The difference is: there is no guarantee that it's possible to find points that are not too close, you could get into an infinite loop. So maximum 3000 rejected points; after that any point will be marked as okay. You can adapt that 3000 to whatever integer you wish. ;; example: block_name "b", 20 points, 1.5 max_scale, 0.01 min_scale, minimum distance = 1000.0 (defun c:scatter ( / ) (while (populate "b" 20 1.5 0.01 1000.0) ;; ) ) You can adapt at line 76, inside function populate: (setq max_tries 3000) --- (defun rnd (/ modulus multiplier increment rand) (if (not seed) (setq seed (getvar "DATE")) ) (setq modulus 65536 multiplier 25173 increment 13849 seed (rem (+ (* multiplier seed) increment) modulus) rand (/ seed modulus) ) ) (defun GroupByNum ( lst n / r) (if lst (cons (reverse (repeat n (setq r (cons (car lst) r) lst (cdr lst)) r)) (GroupByNum lst n) ) ) ) (defun ptonline ( pt pt1 pt2 / vec12 vec1p d result ) (setq vec12 (mapcar '- pt2 pt1)) (setq vec12 (reverse (cdr (reverse vec12)))) (setq vec1p (mapcar '- pt pt1)) (setq vec1p (reverse (cdr (reverse vec1p)))) (setq vec2p (mapcar '- pt2 pt)) (setq vec2p (reverse (cdr (reverse vec2p)))) (setq d (distance '(0.0 0.0) vec12) d1 (distance '(0.0 0.0) vec1p) d2 (distance '(0.0 0.0) vec2p)) (if (equal d (+ d1 d2) 1e-8) (setq result T) (setq result nil)) result ) (defun ptinsideent ( pt ent / msp ptt xlin int k kk tst result ) (vl-load-com) (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq ptt (vlax-curve-getclosestpointto ent pt)) (setq xlin (vla-addxline msp (vlax-3d-point pt) (vlax-3d-point ptt))) (setq int (GroupByNum (vlax-invoke (if (eq (type ent) 'ENAME) (vlax-ename->vla-object ent)) 'intersectwith xlin acExtendBoth) 3)) (setq int (vl-sort int '(lambda (a b) (< (vlax-curve-getparamatpoint xlin a) (vlax-curve-getparamatpoint xlin b))))) (setq k 0) (while (< (setq k (1+ k)) (length int)) (if (and (eq (rem k 2) 1) (ptonline pt (nth (- k 1) int) (nth k int))) (setq tst (cons T tst)) (setq tst (cons nil tst))) ) (setq tst (reverse tst)) (setq k 0) (mapcar '(lambda (x) (setq k (1+ k)) (if (eq x T) (setq kk k))) tst) (vla-delete xlin) (if kk (if (eq (rem kk 2) 1) (setq result T) (setq result nil)) (setq result nil) ) result ) (setq max_tries 3000) (defun not_too_close (pt allpoints min_dist / okay i) (setq okay T) (setq i 0) (if (> max_tries 0) (repeat (length allpoints) (if (< (distance pt (nth i allpoints) ) min_dist ) (setq okay nil) ) (setq max_tries (- max_tries 1)) (setq i (+ i 1)) ) ) okay ) (defun populate ( bname no scf scfmin min_dist / DX DXX DY DYY ENT ENTA MAXPOINT MAXPT MINPOINT MINPT MSP PT SCFF result) (vl-load-com) (setq result nil) (setq allpoints (list)) (setq max_tries 3000) ;; 3000 attemps to reject a block that is too close to other blocks (setq ent (car (entsel "\nPick 2D closed entity"))) (while (eq (cdr (assoc 70 (entget ent))) 0) (prompt "\nPicked entity is open, please pick closed one") (setq ent (car (entsel "\nPick 2D closed entity"))) ) (setq entA (vlax-ename->vla-object ent)) (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (vla-getboundingbox entA 'minpoint 'maxpoint) (setq minpt (vlax-safearray->list minpoint) maxpt (vlax-safearray->list maxpoint) ) (setq dx (- (car maxpt) (car minpt))) (setq dy (- (cadr maxpt) (cadr minpt))) (if (null scfmin) (setq scfmin 1.0)) (while (> no 0) (setq dxx (* dx (rnd))) (setq dyy (* dy (rnd))) (setq pt (list (+ (car minpt) dxx) (+ (cadr minpt) dyy) 0.0)) (if (and (eq scfmin 1.0) (eq scf 1.0)) (setq scff 1.0) (setq scff (+ scfmin (* (- scf scfmin) (rnd))))) (if (and (not_too_close pt allpoints min_dist) (ptinsideent pt ent)) (progn (setq no (1- no)) (setq result (vla-insertblock msp (vlax-3d-point pt) bname scff scff scff (* 2 pi (rnd)))) (setq allpoints (append allpoints (list pt))) ) ) ) result ) (defun c:populate ( / bname no min_dist) (setq bname "") (while (not (tblsearch "BLOCK" bname)) (setq bname (getstring T "\nInput name of block to populate (CASE UNSENSITIVE) : ")) ) (initget 6) (setq no (getint "\nInput number of blocks to populate : ")) (initget 6) (setq scf (getreal "\nInput max. scale factor for block insertion <1.0> : ")) (if (null scf) (setq scf 1.0)) (initget 6) (setq scfmin (getreal "\nInput min. scale factor for block insertion <1.0> : ")) (setq min_dist (getreal "\nMinimum distance: ") ) (while (populate bname no scf scfmin min_dist) ) (princ) ) (defun c:scatter ( / ) (while (populate "b" 20 1.5 0.01 1000.0) ) )

Here is my version with bulges - arcs... (defun c:snakeovercircle ( / *error* *adoc* el ci ce r n c d p k p1 p2 pl bl ) (vl-load-com) (defun *error* ( m ) (vla-endundomark *adoc*) (if m (prompt m) ) (princ) ) (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))) (setq el (entlast)) (prompt "\nPick or specify point to create snake over circle : ") (command "_.CIRCLE") (while (< 0 (getvar 'cmdactive)) (command "\\") ) (if (not (eq el (entlast))) (progn (setq ci (entlast)) (setq ce (cdr (assoc 10 (entget ci)))) (setq r (cdr (assoc 40 (entget ci)))) (initget 7) (setq n (getint "\nSpecify number of double turns : ")) (initget 1 "Yes No") (setq c (getkword "\nAdditional middle turn [Yes/No] : ")) (if (= c "Yes") (progn (setq d (/ (* 2 r) (1+ (* 2 n)))) (setq p (list (+ (car ce) r) (- (cadr ce) r))) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r) (* k d))) (* (1+ k) pi) (sqrt (- (expt r 2) (expt (- r (* (1+ k) d)) 2))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (polar (list (car ce) (cadr p2)) (if (= (rem n 2) 0) pi 0.0) (sqrt (- (expt r 2) (expt (/ d 2) 2))))) (setq pl (cons p pl)) (setq p (polar p (* 0.5 pi) d)) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d) (/ d 2))) (* (+ n k) pi) (sqrt (- (expt r 2) (expt (* (+ k 0.5) d) 2))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (list (+ (car ce) r) (+ (cadr ce) r))) (setq pl (cons p pl)) (setq pl (reverse pl)) (setq bl (cons 0.0 bl)) (setq k -1) (repeat (- (length pl) 2) (setq k (1+ k)) (if (= (rem k 2) 0) (setq bl (cons 0.0 bl)) (setq bl (if (zerop (apply '+ bl)) (cons -1.0 bl) (cons 1.0 bl))) ) ) (setq bl (cons 0.0 bl)) ) (progn (setq d (/ r n)) (setq p (list (+ (car ce) r) (- (cadr ce) r))) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r) (* k d))) (* (1+ k) pi) (sqrt (- (expt r 2) (expt (- r (* (1+ k) d)) 2))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d))) (* (+ n (1+ k)) pi) (sqrt (- (expt r 2) (expt (* k d) 2))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (list (- (car ce) r) (+ (cadr ce) r))) (setq pl (cons p pl)) (setq pl (reverse pl)) (setq bl (cons 0.0 bl)) (setq k -1) (repeat (- (length pl) 2) (setq k (1+ k)) (if (= (rem k 2) 0) (setq bl (cons 0.0 bl)) (setq bl (if (zerop (apply '+ bl)) (cons 1.0 bl) (cons -1.0 bl))) ) ) (setq bl (cons 0.0 bl)) ) ) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length pl)) (cons 70 (if (= (getvar 'plinegen) 1) 128 0)) (cons 38 (caddr (cdr (assoc 10 (entget ci))))) ) (apply 'append (mapcar '(lambda ( a b ) (list (cons 10 a) (cons 42 b))) pl bl)) (list (assoc 210 (entget ci))) (list '(62 . 3)) ) ) ) ) (*error* nil) ) HTH, M.R.

One step? Hmmm....I'm not sure. None I can think of at the moment. I'll have to look into it. I'm glad to hear however that you did get the end result you were looking for.

Hi ReMark, I don't know if you remember me, but you were very helpful in my last Cad class. The result I want is what you showed, and I did get it using the slice command, but I was wondering if there was just a one step procedure using presspull, or something else. Maybe I could have gone about drawing the object differently to start, and then I wouldn't have this issue!

Is this the affect you're looking for? There is another way to do it too.

Press/Pull or Extrude and then use the Slice command might be one option.