Leaderboard

The RECTANG command is already have fillet option within so you need to specify it only once then draw the rectangle required.

This? (vl-load-com) (defun add_vtx (obj add_pt ent_name / bulg) (vla-addVertex obj (1+ (fix add_pt)) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 1)) (list (car (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name)) (cadr (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name)) ) ) ) ) (setq bulg (vla-GetBulge obj (fix add_pt))) (vla-SetBulge obj (fix add_pt) (/ (sin (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4)) (cos (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4)) ) ) (vla-SetBulge obj (1+ (fix add_pt)) (/ (sin (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4)) (cos (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4)) ) ) (vla-update obj) ) (defun c:div-vertex_po ( / ss max_l n ent obj_vla pr dist_end dist_start seg_len div l_div l) (princ "\nSelect polylines.") (while (null (setq ss (ssget '((0 . "LWPOLYLINE"))))) (princ "\nSelect is empty, or isn't POLYLINE!") ) (initget 7) (setq max_l (getdist "\nMax length between vertex: ")) (repeat (setq n (sslength ss)) (setq ent (ssname ss (setq n (1- n))) obj_vla (vlax-ename->vla-object ent) pr (fix (vlax-curve-getEndParam ent)) ) (repeat (fix (vlax-curve-getEndParam ent)) (setq dist_end (vlax-curve-GetDistAtParam ent pr) dist_start (vlax-curve-GetDistAtParam ent (setq pr (1- pr))) seg_len (- dist_end dist_start) div (1+ (fix (/ seg_len max_l))) l_div (/ seg_len div) l l_div ) (while (< l seg_len) (add_vtx obj_vla (vlax-curve-getparamatdist ent (- dist_end l)) ent) (setq l (+ l l_div)) ) ) ) (prin1) )

FWIW, here's a similar program I've posted previously - https://www.theswamp.org/index.php?topic=44444.msg496892#msg496892

Etransmit settings are stored in the registry: Assuming you're all on the same version of CAD you could export these keys and import. ( Untested ) You could also look at all the subkeys and their values and possibly write them using lisp:

Try this: (defun c:calcVR(/ sum sumCubic ss i dim m) (setq sum 0 sumCubic 0 ) (setq ss (ssget '((0 . "DIMENSION")))) (repeat (setq i (sslength ss)) (setq dim (vlax-ename->vla-object (ssname ss (setq i (1- i))))) (if (/= (vlax-get dim 'textOverride) "") (setq m (atof (vlax-get dim 'textOverride))) (setq m (atof (rtos (vlax-get dim 'measurement) 2 (vlax-get dim 'TolerancePrecision)))) ) (setq sum (+ sum m) sumCubic (+ sumCubic (expt m 3)) ) ) (alert (strcat "Vão regulador: " (rtos (sqrt (/ sumCubic sum)) 2 0))) (princ) )

Taking MHUPP and adding a bit more.... (meaning he beat me to it again) This is what I use - a longer version than above. Technical bit - each snap option has a value (0, 1, 2, 4, ....) and adding these together will give you the value you want to use in 'osmode variable. Looking at the list below to add up what you want. For a simple example a value of 3 means "End Point" + "Mid Point" which is the sum MHUPP did for you to get 191. I wouldn't have done the calculation, just given you this and let you work it out!! In mine below, change the (* 1 or (* 0 so that it is a 1 if you want to use the snap, 0 if you don't (so I have end point, mid point, centre but not node or quadrant). The first option "none" is just there for completion - has no effect (1 x 0 or 0 x 0 = 0), it will add it up for you and set the snaps. MHUPP: Borrowed your routine name and the princ at the end, ta! (defun c:os ( / snaps) (setq snaps 0) (setq snaps (+ snaps (* 1 0))) ;None (setq snaps (+ snaps (* 1 1))) ;End Point (setq snaps (+ snaps (* 1 2))) ;Mid Point (setq snaps (+ snaps (* 1 4))) ;Centre (setq snaps (+ snaps (* 0 8))) ;Node (setq snaps (+ snaps (* 0 16))) ;Quadrant (setq snaps (+ snaps (* 1 32))) ;Intersection (setq snaps (+ snaps (* 0 64))) ;Insertion (setq snaps (+ snaps (* 0 128))) ;Perpendicular (setq snaps (+ snaps (* 1 256))) ;Tangent (setq snaps (+ snaps (* 0 512))) ;Nearest (setq snaps (+ snaps (* 0 1024))) ;Geometric Centre (setq snaps (+ snaps (* 1 2048))) ;Apparent Intersection (setq snaps (+ snaps (* 0 4096))) ;Extrnsion (setq snaps (+ snaps (* 0 8192))) ;Parallel (setq snaps (+ snaps (* 0 16348))) ;Superess all running snaps (setvar 'osmode snaps) (prompt "Osnap Settings set") )

So you plotting from Model space or layout ? Google "plotting Maratovich" has a good package handles lots of combinations. I have plot range etc of layouts of different sizes but not model, only have plot all in model but 1 size. Big hint use layouts.

id remove the pauses StevenP (defun C:BN () (command "_.Mirror") ) or duolicate the comand in the cui with BN as the shortcut

(defun c:bn ( / ) (command "mirror" pause pause pause pause) ) ?

If you want all the dimension styles you might need to add this function somewhere: (defun tablesearch ( s / d r) ;;List Dimstyles (while (setq d (tblnext s (null d))) (setq r (cons (cdr (assoc 2 d)) r)) ) ) and to loop through the list something like this: (foreach x (tableSearch "dimstyle") --- do stuff (princ "\n") (princ x) ; for example ) ; end foreach That isn't what I was going to say though, I have found that adjusting the text sizes a lot can make the spacing and arrows out or proportion, the LISP I use does this with dimstyles rather than MHUPPs entmod method - you might want to search for that as well. For example a text size of 250 dwarfs an arrow size of 2.5 MHUPP is pretty good with this stuff and might modify his for example to put arrow size to the same as text size to show how to build up his code to add more stuff (I don't know the code for 'arrow size' )

There is already a default command for that "LAYTHW"

The last one I put together for someone on here was all copied from the internet - nothing wrong with that! Might try something like: (defun c:testthis ( / MySS ) ; define the function, thest this, define local variables after the '/' (setq MySS (ssget "_A") ) ; Make a selection set - a selection of everything (ssget) with a filter "_A" - excluding locked layers (command "copybase" (list 0 0) MySS "") ; Run the CAD command "Copybase". Whjat is after it is all the imputs you'd normally do ) as a simple start to copy everything on the drawing apart from locked layers. Added some notes - it isn't too hard to follow these 4 lines though From there just search out each step as you need - perhaps the next one is "how to delete a selection set" and just add it in, using MySS

My 0.02¢ xref the drawings in question. This is what I did for my old job anything that was reference drawing (arch, sprinkler, civil) I would open their drawing change everything to 252 color and then xref into my drawing. with plot styles 252 color was set to 50% screening. Meaning anything drawing by me would pop and the reference drawing was still seen but muted. Only draw back is if you move project folders you will have to tell autocad where the xref files are located.

All you have to do is double click on the bar, where I'm showing in the image below. You may have to do this several times in order to get back to the ribbon interface.

Rectangle p1 p2 ask for fillet radius fillet command with polyline option profit ??

Yes, a spline is created. Rather than creating two helixes, one representing the centerline of the groove could be made and then offset used to create the two sides of the grove.

I could be wrong, but as far as I know, there are no 3rd party converters for .rfa to .dwg or .stp. This is the same issue I have with 3ds max files. I have a bunch of old max files that I can't do anything with because I no longer have access to the program. I think the only way to deal with the .rfa files would be to open them in Revit and save them to .dwg. Maybe you could find someone to do the conversions for you?

The image of the spiral is distorted as noted below. Position the image so that the center is at 0,0 then lock its layer. CReate points above the center to define where the helix should pass. Make sure the helix center is also at 0,0. Create a CW helix of 3 turns. Drag its grips so that it looks like the red helix below. Make a copy of the red helix (copy 0,0) and change the number of turns of the copy to 4. Then drag its start and end handles as needed. Use splines and or arc to complete the geometry.

and this one is it all put together, It doesn't make a table - should be easy enough to do that but though Command is: lstgrpblks See the last part for the next stages you might be able to do that? ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/list-of-group-names-on-drawing/td-p/807566 (defun grp:list-groups ( / doc return) (setq doc (vla-get-activeDocument (vlax-get-acad-object))) (vlax-for group (vla-get-groups doc) (setq return (cons (vla-get-name group) return)) ) ; end vlax-for (mapcar 'strcase (reverse return)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;https://adndevblog.typepad.com/autocad/2012/12/how-to-add-a-group-in-a-selection-set-from-an-autolisp-function.html ;;Lee Mac option ;;get all the items in a group ;;(defun selgrp (grpname / frp a1 ss ent) (defun selgrp (grpname / frp a1 ss ent enttype) ;; grpname is the group name, it accepts unnamed groupnames, such as *A1 (setq grp (dictsearch (namedobjdict) "ACAD_GROUP")) (setq a1 (dictsearch (cdr (assoc -1 grp)) grpname)) (setq ss (ssadd)) (while (/= (assoc 340 a1) nil) (setq ent (assoc 340 a1)) (if (= (cdr (assoc 0 (entget (cdr ent)))) "INSERT") ; only blocks (progn (setq ss (ssadd (cdr ent) ss)) ) ; end progn (progn ) ; end progn ) ; end if (setq a1 (subst (cons 0 "") ent a1)) ) ; end while ss ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;https://www.cadtutor.net/forum/topic/55506-lisp-to-return-name-of-selected-blocks/ ;;(defun c:simplecount ( / blk idx itm lst sel ) ;; Define function, declare local variables (defun simplecount ( sel / blk idx itm lst ) ;; Define function, declare local variables (setq SimpLspResult (list)) ;; (if ;; If the following expression returns a non-nil value ;; (setq sel ;; Assign the value returned by the following expression to the symbol 'sel' ;; (ssget ;; Prompt the user to make a selection and return the selection set if successful ;; '((0 . "INSERT")) ;; Filter the selection to block references only (INSERTs) ;; ) ;; end ssget ;; ) ;; end setq (repeat ;; Repeat the enclosed expressions the following number of times: (setq idx ;; Assign the value returned by the following expression to the symbol 'idx' (sslength sel) ;; Return the number of items in the selection set ) ;; end setq (setq blk ;; Assign the block name to the variable 'blk' (cdr ;; Retrieve the value associated with DXF group 2 (the block name) (assoc 2 ;; Retrieve the DXF group 2 dotted pair from the following DXF data (entget ;; Retrieve the list of DXF data for the following entity (ssname sel ;; Retrieve the entity at the following index (setq idx (1- idx)) ;; Decrement the index variable (since selection set indexes are zero-based) ) ;; end ssname ) ;; end entget ) ;; end assoc ) ;; end cdr ) ;; end setq ;; If the block is already recorded in the list: (if ;; If the following expression returns a non-nil value (setq itm ;; Assign the value returned by the following expression to the symbol 'itm' (assoc blk lst) ;; Attempt to retrieve a list item whose first element is equal to the block name ) ;; end setq ;; Update the existing list entry: (setq lst ;; Redefine the 'lst' variable with the updated list data (subst ;; Substitute the following list item in the list (cons blk (1+ (cdr itm))) ;; Increment the number of occurrences recorded for this item in the list itm ;; The existing item to be substituted lst ;; The list in which to perform the substitution ) ;; end subst ) ;; end setq ;; Else add a new entry to the list: (setq lst ;; Redefine the 'lst' variable with the following updated list data (cons ;; 'Push' a new item onto the front of the list (cons blk 1) ;; Construct a dotted pair whose first key is the block name and value is 1 lst ;; The list to which the item should be added (may be nil) ) ;; end cons ) ;; end setq ) ;; end if ) ;; end repeat ;; Else the user didn't make a selection ;; ) ;; end if ;; Print the results (if they exist) (foreach itm lst ;; For every 'itm' in the list given by 'lst' ;; (princ ;; Print the following to the command-line (setq SimpLspResult (append SimpLspResult (list (strcat ;; Concatenate the following strings "\n" ;; (New-line character) (car itm) ;; The block name ": " ;; An arbitrary separator for the data (itoa (cdr itm)) ;; The number of occurrences of the block, converted to a string ) ;; end strcat ))) ; end setq ;; ) ;; end princ ) ;; end foreach (princ) ;; Suppress the return of the last evaluated expression (if) SimpLspResult ; return result ) ;; end defun ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:lstgrpblks ( / MyGroups acount GroupsSS blklst) (setq MyGroups ( grp:list-groups ) ) (setq acount 0) (setq GroupsSS (list)) (while (< acount (length MyGroups)) (setq blklst (simplecount (selgrp (nth acount MyGroups)) ) ) (princ "\n") (princ (nth acount MyGroups)) ;; Group Name (princ "\n") (princ blklst) ;; blklst: Block name : Ocurrance. Use LM string -> List to split up (del ':'), ;; append this list as MyGroup Block_name Occurances ;; get insert point for table ;; entmake table (setq acount (+ acount 1)) ) ; end while )

As suggested I use a custom mnu rather than using the CUI as the editor, you just make a menu using notepad. You can make custom toolbars the same way. Behind the menu is a Autoload or a load a lisp. Another

Simple way would be bounding box of circle. this creates points around circle. http://www.lee-mac.com/entitytopointlist.html

Personally I don't tend to use the getpropertyvalue/setpropertyvalue functions (in favour of operating on the attribute reference entities/objects directly), but in testing, both functions will return an error if the supplied tag name does not correspond to an attribute reference held by the block. As such, issuing a call to getpropertyvalue prior to setpropertyvalue will offer no benefit in this case. Instead, you could account for errors using the vl-catch-all-apply function, e.g. the following will return T if successful, else nil: (not (vl-catch-all-error-p (vl-catch-all-apply 'setpropertyvalue (list obj "QUANTITY" (rtos (* di ht) 2 3)))))

In case someone is interested... I was making a Match all dynamic props function; I found this "origin" problem, Google brought me here... Here's what I did ;;(setq source (car (entsel "\nSelect source block: "))) ;;(setq dest (car (entsel "\nSelect destinaion block: "))) (defun match_props (source dest / props ) (setq props (LM:getdynprops (vlax-ename->vla-object source))) (setq props (filter_props props)) (LM:setdynprops (vlax-ename->vla-object dest) props) ) ;; the "ORIGIN" key is a READONLY prop, so it must beremoved (defun filter_props (props / newprops prop) (setq newprops (list)) (foreach prop props (if (= "Origin" (car prop)) T (setq newprops (append newprops (list prop))) ) ) newprops )

You could try this: I made a bunch of global variables. They get set to the default. COMMAND sadv runs a function that asks you to set the values. You can run this once if you want. Those values are remembered as long as the file is open. ;;------------------------------------ DIMLP.LSP - label lines (Pipes) with detailed layer name---------------------------------;; ;; fixo () 2012 * all rights released ;; edited 3/3/12 ;; label lines (Pipes) with layer name ;;;;;;;;;;;;;;;;;;;;; ;; global variables, defaults (setq globalvar_YN "Pipe") (setq globalvar_Bg "No") (setq globalvar_ht (atof "1")) (setq globalvar_RP "Yes") (setq globalvar_txh1 2) (setq globalvar_MinLen 5) (setq a (substr " " 1 1)) (setq globalvar_pipetype "PVC PIPE") (setq globalvar_pipetype (strcat globalvar_pipetype a)) ;; setq a bunch of global variables, as variables. (defun setDefaults ( / YN Bg ht RP txh1 MinLen pipetype) (initget "Current Pipe") (if (null (setq YN (getkword "\nChoose Text Layer [Current/Pipe] <Pipe>: "))) (setq YN "Pipe") ) (initget "Yes No") (if (null (setq Bg (getkword "\nAdd Text Background [Yes/No] <No>: "))) (setq Bg "No") ) (setq ht (getreal "\nSet Length factor (If Drawing Units mm-Set 1000, If Drawig Units m-Set 1)<1>: ")) (if (= ht nil) (setq ht (atof "1")) ) (initget "Yes No") (if (null (setq RP (getkword "\nRound Pipe Length? [Yes/No] <Yes>: "))) (setq RP "Yes") ) ; (setq dcpr (getint "\nSet Decimal Precision <0>: ")) ; (if (= dcpr nil) ; (setq dcpr (atoi "0")) ; ) (setq ht (/ 1 ht)) (setq txh1 (getreal "\nEnter text height<2>: ")) (if (= txh1 nil) (setq txh1 2) ) (setq pipetype (getstring T "\nPipe Type<PVC PIPE>: ")) (if (= pipetype "") (setq pipetype "PVC PIPE") ) (setq MinLen (getreal "\nSet Min. Length To Calc<5.0>: ")) (if (= MinLen nil) (setq MinLen 5) ) (setq a (substr " " 1 1)) (setq pipetype (strcat pipetype a)) ; (setq pipepn (strcase (getstring "\nPipe Type</6>: "))) ; (if (= pipepn "") ; (setq pipepn "/6") ; ) ;; copy these default values to global vars (setq globalvar_YN YN) (setq globalvar_Bg Bg) (setq globalvar_ht ht) (setq globalvar_RP RP) (setq globalvar_txh1 txh1) (setq globalvar_MinLen MinLen) (setq globalvar_pipetype pipetype) ) (defun c:sadv ( / ) (setDefaults) (princ) ) (defun C:DIMLPDET_UPDATE(/ *error* acsp adoc ang curve deriv en mid mp ppt1 ppt2 prex sset txh txt txt1 txt2 txtln txtpt1 insut LAYERNAME offst pipetype pipepn a theMText dcpr RP MinLen) (vl-load-com) (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (defun *error* (msg) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)) ) (cond ((or (not msg) (member msg '("console break" "Function cancelled" "quit / exit abort")) ) ) ((princ (strcat "\nError: " msg))) ) (princ) ) ;; copy the global vars values to local vars defaults (setq YN globalvar_YN) (setq Bg globalvar_Bg) (setq ht globalvar_ht) (setq RP globalvar_RP) (setq txh1 globalvar_txh1) (setq MinLen globalvar_MinLen) (setq pipetype globalvar_pipetype) ;;;;;;;;;;;;;;;;;;;;end defaults;;;;;;;;;;;;;;;; (setq offst (/ txh1 2)) (setq insut (getvar "insunits")) (setq adoc (vla-get-activedocument (vlax-get-acad-object)) acsp (vla-get-block(vla-get-activelayout adoc))) (vla-startundomark adoc ) (setq txh txh1 prex (getvar "dimdec") ) (while (not sset) (setq sset (ssget '((0 . "*LINE")))) ) (while (setq en (ssname sset 0)) (setq curve (vlax-ename->vla-object en)) ;;(setq txt1 (rtos (vla-get-length curve) 2 2)) (setq txtln (if (= (getvar "measurement") 0) (rtos (vla-get-length curve) 3 2) (rtos (vla-get-length curve) 2 2)) ) (setq txtln (atof txtln)) (if (> txtln MinLen) ;; start if minimum length (progn ;; start progn minimum length (if (= RP "Yes") (progn (if (< 0.5 (rem txtln 1)) (setq txtln (+ txtln 1)) ) (setq txtln (fix txtln)) (setq txtln (rtos (* txtln ht) 2 0)) ) (setq txtln (rtos (* txtln ht) 2 2)) ) (setq LAYERNAME (vla-get-layer curve)) (setq mid (/ (abs (- (vlax-curve-getendparam curve) (vlax-curve-getstartparam curve))) 2.) mp (vlax-curve-getpointatparam curve mid) deriv (vlax-curve-getfirstderiv curve (vlax-curve-getparamatpoint curve mp)) ) (if (zerop (cadr deriv)) (setq ang 0) (setq ang (- (/ pi 2) (atan (/ (car deriv) (cadr deriv))))) ) (if (< (/ pi 2) ang (* pi 1.5)) (setq ang (+ pi ang)) ) ;;; (setq ppt1 (polar mp (+ ang (/ pi 2)) (* txh 0.5)) ;;; ) (setq ppt1 (polar mp (+ ang (/ pi 2)) offst) ) (setq txtpt1 (vlax-3d-point (trans ppt1 1 0))) ;;; (setq txt1 (vla-addtext acsp txt txtpt1 txh)) ;(setq txt (strcat LAYERNAME pipepn)) (setq txt (strcat LAYERNAME " L=" (strcat txtln "m"))) (setq txt (vl-string-subst pipetype "P_" txt)) (setq txt (vl-string-subst "/" "-" txt)) (setq theMText (vla-AddMText mspace txtpt1 (atof "0") txt)) (vla-put-AttachmentPoint theMText acBottomCenter) ;;(vla-put-alignment theMText acAlignmentBottomCenter) ;;(vla-put-textalignmentpoint theMText txtpt1) ;;(vla-put-insertionpoint theMText (vla-get-textalignmentpoint theMText)) (vla-put-rotation theMText ang) (vla-put-Height theMText txh) (if (= Bg "Yes") (progn (vla-put-backgroundfill theMText :vlax-true) (setq dxf_ent (entget (entlast))) (entmod (append dxf_ent '((90 . 1) (63 . 254) (45 . 1.1) (441 . 0)))) ) ) (if (= YN "Pipe") (vlax-put-property theMText 'layer LAYERNAME) ) ;(setq txt1 (vla-addtext acsp txt txtpt1 txh)) ;(vla-put-alignment txt1 acAlignmentBottomCenter) ;(vla-put-textalignmentpoint txt1 txtpt1) ;(vla-put-insertionpoint txt1 (vla-get-textalignmentpoint txt1)) ; (vla-put-rotation txt1 ang) ;(if (= YN "Pipe") ; (vlax-put-property txt1 'layer LAYERNAME) ; ) );; end progn minimum length );; end if minimum length (ssdel en sset) ) (*error* nil) (princ) ) (princ "\n\t---\tStart command with \"DIMLPDET\"\t---") (princ) (or (vl-load-com) (princ)) ;;------------------------------------ code end ----------------------------------;;

I think that is letting you know about selection cycling. Turn it off with (setvar 'SELECTIONCYCLING 0)

i have it working guys, so long story short, i should have read "ALL" of the header test of the Steal.lsp, and not just some (lesson learned the hard way, but learned non the less).. So Lee has already made this lisp program accessible as a sub function also So with the following code (tweaked from mhupp's above... my thanks once more) it now does exactly what I need from a new page (defun c:GetLastFile (/ Filsys FilObj DatMod lst nfilepath) (setq FilSys (vlax-create-object "Scripting.FileSystemObject") path "C:\\Workflow" ) (foreach F (vl-directory-files path "*.DWG" 1) (setq FilObj (vlax-invoke FilSys 'GetFile (strcat path "\\" F)) DatMod (vlax-get FilObj 'DateLastModified) lst (cons (cons F DatMod) lst) ) ) (vlax-release-object FilObj) (vlax-release-object FilSys) (setq lst (mapcar '(lambda (l) (car (nth l lst))) (vl-sort-i lst '(lambda (d1 d2) (> (cdr d1) (cdr d2)))))) ;(setq nfile (car lst)) ;newest file in folder (setq nfilepath (strcat path "\\" (car lst))) ;or if you need the full path (Steal nfilepath '( ( "Blocks" ("*") ) ( "Layers" ("*") ) ( "Dimension Styles" ("*") ) ( "Text Styles" ("*") ) ( "Multileader Styles" ("*") ) ) ) (Princ "\nPrior Order Data import finished") (princ) ) My thanks again to everyone that helped... You guys rock!

I started from scratch. Is this how you want is? Bottom function: adapt the text height to your likings . Now: (setq hgt 2.5) ;;1. promt the user to select multiple polygons. ;;2. in a loop: ;; a. calculate each polygon area. ;; b. insert the area text in the geometric center of each polygon (vl-load-com) ;; Multiple assoc. Returns a list of all requested (assoc) with set key ; use like this (massoc 10 YourListOfData) (defun massoc (key alist / x nlist) (foreach x alist (if (eq key (car x)) (setq nlist (cons (cdr x) nlist)) ) ) (reverse nlist) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/ (defun drawText (pt hgt str) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 1 str)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; main function (defun wamp (pline hgt / area pt str vert_pts x y p) (setq area (vla-get-area (vlax-ename->vla-object pline) )) ;; get the vertex positions. (setq vert_pts (massoc 10 (entget pline))) (setq x 0.0) (setq y 0.0) ;; Then calculate the average. Sum of x and y values divided by the number of vertices (foreach p vert_pts (setq x (+ x (nth 0 p))) (setq y (+ y (nth 1 p))) ) (setq pt (list (/ x (length vert_pts)) (/ y (length vert_pts)) )) ;; make a string out of the area float. Here would be the place to add a prefix or postfix. Example: ;; (setq str (strcat "area: " (rtos area 2 3) )) (setq str (rtos area 2 3)) ;; that 3 means 3 decimals. Feel free to change this (drawText pt hgt str) (princ ) ) ;; WAMP for Write Area in the Middle of Polyline (defun c:wamp ( / pline ss i hgt) ;; User setting. Set to your liking (setq hgt 2.5) ;; user selects polylines (princ "\nSelect polylines: ") (setq ss (ssget (list (cons 0 "*POLYLINE")))) ;; loop of the elements (setq i 0) (repeat (sslength ss) (setq pline (ssname ss i)) (wamp pline hgt) (setq i (+ i 1)) ) )

I would look at using a wipeout rather than a trim then your pline still exists but will look like its broken just make a polygon rather than a circle if you have a reasonable number of sides it will look like a circle. 20 sides

And why not apply a donut of white color and the circle of the color of the current layer? So in paper space or when printing it will look the same as if the polyline was adjusted. In addition you keep your polyline in one piece... (defun C:CC (/ coords ent rad) (initget 7) (setq rad (getdist "\nEnter radius: ")) (while (setq ent (entsel "\nSelect polyline (or press Enter to Exit) >> ")) (setq ent (car ent) coords (vl-remove-if 'not (mapcar (function (lambda (p) (if (= 10 (car p)) (cdr p)) ) ) (entget ent) ) ) ) (foreach pt coords (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) (cons 8 (getvar "CLAYER")) '(62 . 7) '(420 . 16777215) '(100 . "AcDbPolyline") '(90 . 2) '(70 . 1) (cons 43 rad) (cons 38 (getvar "ELEVATION")) (cons 39 (getvar "THICKNESS")) '(39 . 0.0) (cons 10 (trans (list (+ (car pt) (* 0.5 rad)) (cadr pt)) 1 0)) (cons 40 rad) (cons 41 rad) '(42 . 1.0) '(91 . 0) (cons 10 (trans (list (- (car pt) (* 0.5 rad)) (cadr pt)) 1 0)) (cons 40 rad) (cons 41 rad) '(42 . 1.0) '(91 . 0) '(210 0.0 0.0 1.0) ) ) (entmake (list '(0 . "CIRCLE") '(100 . "AcDbEntity") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) (cons 8 (getvar "CLAYER")) (cons 10 (trans pt 1 0)) (cons 40 rad) '(210 0.0 0.0 1.0) ) ) ) ) (princ) )

*Post removed* .. bad suggestion.

This looks easier than I though. There are a few options for steal, such as below, StealLast (which steals from the last drawing you stole from) Each of these options have this line (steal <dwg> <lst> ) which calls the main routine.... so use MHUPPs latest drawing to get the drawing name (and filepath, probably taking note of double \\ in there too), then simple (steal MyDrawing.dwg) will bring up the dialogue box to select what to steal. if you also look at the StealAll LISP this will give you a clue at what to do to set what to steal each time (a few fewer button presses and dialogue box) Play with it over the weekend! (defun c:StealLast nil (Steal (if (setq dwg (getenv "LMac\\StealLast")) (findfile dwg) ) nil ) ) MHUPP - going to 'steal' what you did for something else that has been in the back of my mind for ages, a batch process selecting that days work for example to plot or PDF what I have done, think DatMod (vlax-get FilObj 'DateLastModified) will do the trick!

Thanks guys Yeah, I see where this could go now... Thanks Mhupp for that snippet of code, and yeah if you have time StevenP some hints would be appreciated. Don't worry if you don't have time, your last post and Mhupps post has given me a great starting point to play with.

This will create a list of files in the given folder from newest to oldest. (setq FilSys (vlax-create-object "Scripting.FileSystemObject") path "C:\\Folder\\path" ) (foreach F (vl-directory-files path "*.DWG" 1) (setq FilObj (vlax-invoke FilSys 'GetFile (strcat path "\\" F)) DatMod (vlax-get FilObj 'DateLastModified) lst (cons (cons F DatMod) lst) ) ) (vlax-release-object FilObj) (vlax-release-object FilSys) (setq lst (mapcar '(lambda (l) (car (nth l lst))) (vl-sort-i lst '(lambda (d1 d2) (> (cdr d1) (cdr d2)))))) (setq nfile (car lst)) ;newest file in folder ;(setq nfilepath (strcat path "\\" (car lst))) or if you need the full path

That is OBject Data, you need to have say CIV3D or Map to get at that info. (setq ent (car (entsel "\nPick object with OD data "))) (setq odname (ade_odgettables ent)) (setq Stnum (ade_odgetfield ent odname "STREET_NUMBER" 0)) (setq Stname (ade_odgetfield ent odname "STREET_NAME" 0)) Try "Name_0" for the data name in example code.

@Aftertouch Glad you got it working FWIW I'd refactor the code like so: (vl-registry-write (setq regeditetransmit (strcat "HKEY_CURRENT_USER\\" (vlax-product-key) "\\Etransmit\\setups\\COMPANY SETUP" ) ) ) (foreach pair '(("AEC_EXPLODE_DWG" 0) ("AEC_TEMP_SETUP" 0) ("BindType" 0) ("BindXref" 0) ("Description" "") ("DestFile" "") ("DestFileAction" 0) ("DestFolder" "") ("FilePathOption" 0) ("IncludeDataLinkFile" 1) ("IncludeFont" 1) ("IncludeMaterialTextures" 1) ("IncludePhotometricWebFile" 1) ("IncludeSSFiles" 1) ("IncludeUnloadedReferences" 0) ("Name" "COMPANY SETUP") ("PackageType" 0) ("PurgeDatabase" 0) ("RootFolder" "") ("SaveDrawingFormat" 6) ("SendMail" 0) ("SetPlotterNone" 0) ("ShowInFolder" 0) ("UsePassword" 0) ("VisualFidelity" 1) ) (vl-registry-write regeditetransmit (car pair) (cadr pair)) )

A possible quick fix (0 . "LWPOLYLINE") is a 2d polyline (0 . "POLYLINE") is a 3d polyline So use (0 . "*LINE") will find both types.

Not wanting the brain to atrophy over the holiday season. I thought to post a hatch pattern that I have called Trilobe-E. I expect others can make a hatch pattern faster with various tools, but I like to use Autocad and trigonometry (in a spread sheet). It was based on a unit sized hexagon. As the grid is a hexagonal one instead of an orthogonal one, the brain was given good exercise. I am posting the text of the file as well as the pattern file. *Trilobe-E, trilobe pattern 307.589089469,3,3,12.1236363414,0.1320676359,0.15069,-19.521625573 322.410910531,3.0919,2.8806,9.6409374243,-0.2287478555,0.15069,-11.2071266916 337.589089469,3.2113,2.7887,9.6409374243,0.2287478555,0.15069,-11.2071266916 352.410910531,3.3506,2.7312,12.1236363414,-0.1320676359,0.15069,-19.521625573 7.589089469,3.5,2.7113,12.1236363414,0.132067636,0.15069,-19.521625573 22.410910531,3.6494,2.7312,9.6409374243,-0.2287478555,0.15069,-11.2071266916 37.589089469,3.7887,2.7887,9.6409374243,0.2287478555,0.15069,-11.2071266916 52.410910531,3.9081,2.8806,7.5486792315,0.132067636,0.15069,-19.521625573 112.410910531,4,3,12.1236363414,-0.132067636,0.15069,-19.521625573 97.589089469,3.9425,3.1393,-9.6409374243,-0.2287478555,0.15069,-11.2071266916 82.410910531,3.9226,3.2887,9.6409374243,-0.2287478555,0.15069,-11.2071266916 67.589089469,3.9426,3.438,12.1236363414,0.132067636,0.15069,-19.521625573 52.410910531,4,3.5774,7.5486792315,0.132067636,0.15069,-19.521625573 37.589089469,4.0919,3.6968,9.6409374243,0.2287478555,0.15069,-11.2071266916 22.410910531,4.2113,3.7887,9.6409374243,-0.2287478555,0.15069,-11.2071266916 7.589089459,4.3506,3.8461,12.1236363414,0.132067636,0.15069,-19.521625573 67.589089469,4.5,3.866,12.1236363414,0.132067636,0.15069,-19.52162557 82.410910531,4.5575,4.0053,9.6409374243,-0.2287478555,0.15069,-11.2071266916 97.58908946,4.5774,4.1547,9.6409374243,0.2287478555,0.15069,-11.2071266916 112.410910531,4.5574,4.3041,12.1236363414,-0.132067636,0.15069,-19.52162557 127.589089469,4.5,4.4434,7.5486792315,-0.132067636,0.15069,-19.52162557 142.410910531,4.4081,4.5628,9.6409374243,-0.2287478555,0.15069,-11.2071266916 157.589089469,4.2887,4.6547,9.6409374243,0.2287478555,0.15069,-11.2071266916 172.410910531,4.1494,4.7121,7.5486792315,0.132067636,0.15069,-19.52162557 *eldon fecit MMXXIII Trilobe-E.pat

You have to use ssnamex to get all the entity names (defun c:Mlabel (/ SS ent obj) (vl-load-com) (if (setq SS (ssget)) ; gets a selection set (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (redraw ent 3) ;Highlight entity that layer name will be pulled from (vl-cmdf "_.mleader" "_non" (vlax-curve-getclosestpointto (setq obj (vlax-ename->vla-object ent)) (getpoint "\nSpecify first point: ")) "\\") ;this will pick a point on the entity (while (eq (logand 1 (getvar 'CMDACTIVE)) 1) (vl-cmdf "")) ;wait for 2nd point for mleader (vla-put-textstring (vlax-ename->vla-object (entlast)) (vlax-get-property obj 'Layer) ) (redraw ent 4) ;un-highlight entity ) ) (princ) ) --Edit Will need to add a bit more code. ill have something later tonight. needed to add redraw so the current entity would be highlighted so user can pick a point closest to it moves the leader point onto the entity waits for 2nd point cmdactive reused from original lisp. un-highlights entity so next loop the current entity will only be highlighted.

There is a new BREAKATPOINT command that does this. I made an alias of BAP for it

Hola Toni . por favor sube tu DWG . Hi Toni , please upload your DWG. Lisp can do any mathematical formula as it have this functions 1 Mathematics + --------- Add - --------- Subtract * --------- Multiply / --------- Divide rem ------- Remainder of integer division 1+ -------- Increment by one 1- -------- Decrement by one abs ------- Absolute fix ------- Truncates a real to an integer float ----- Converts an integer to a real gcd ------- Greatest common denominator min ------- Smallest (least) of group max ------- Largest (greatest) of group sqrt ------ Square root expt ------ Exponent exp ------- Power of e log ------- Natural log cvunit ---- Converts a value from one unit to another 2 Geometry & trigonometry distance -- Returns distance between two points angle ----- Returns angle between two points polar ----- Returns a point at a given distance and angle from a base point inters ---- Returns point at which two lines intersect sin ------- Sine cos ------- Cosine atan ------ Arctangent

For years now did not edit acad.lsp etc but rather I have a custom lisp yes its called Autoload.lsp with all my defuns, shortcuts, (AUTOLOAD etc and yes it works with Bricscad. Just go to Appload and add it to the startup suite list, then it will autoload and run the lisp on startup.

;;----------------------------------------------------------------------------;; ;; Set Osnaps to Endpoint, Midpoint, Center, Node, Quadrant, Intersection, Perpendicular (defun C:OS () (setvar 'osmode 191) (prompt "Osnap Settings set") (princ) )

I might be tempted to combine these to a single -capture everything- LISP using something like (if (findfile "ISO..lin") (setq linefile "Iso.lin") (setq linefile "acadiso.lin") ) fewer files to manage.

mid is the point (defun c:FOO (/ pt1 pt2 mid) (if (and (setq pt1 (getpoint "\nSpecify first point: ")) (setq pt2 (getpoint "\nSpecify second point: "))) (progn (setq mid (mapcar '/ (mapcar '+ pt1 pt2) '(2 2 2))) (prompt "\nThe midpoint is: ") (princ mid) (entmake (list (cons 0 "POINT") (cons 10 mid))) ) ) (princ) )

The dimension variables are massive finding a list with explanations is difficult. This is not bad some may not be correct forget where I found it (cons 0 "DIMSTYLE") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbDimStyleTableRecord") (cons 2 Dim_Name) ;Dim style name (cons 70 0) ; Standard flag (cons 3 " [m]"); DIMPOST (cons 4 ""); DIMAPOST (cons 5 DIMBLK-Name) ;DIMBLK-Name of block instead of default arrowhead (cons 6 DIMBLK-Name);(cons 6 "ClosedFilled"); DIMBLK1 (cons 7 "");(cons 7 DIMBLK-Name); DIMBLK2 (cons 170 0) ;DIMALT-turns off alternate units (cons 40 dimscale) ;DIMSCALE-sets the overall scale factor applied to all dimensions (cons 41 Arrow_Size) ;DIMASZ-sets the size of the arrow/tick (cons 42 Extension_Line_Origin_Offset); DIMEXO (cons 43 Dimension_Line_Spacing); DIMDLI (cons 44 Extension_Above_Dimension_Line) ;DIMEXE-specifies how far to extend the extention line beyound the dim line (cons 45 0.0); DIMRND (cons 46 0) ;DIMDLE-sets the distance the dimension line extends beyond the extension line (cons 47 0.0); DIMTP (cons 48 0.0); DIMTM (cons 71 0); DIMTOL (cons 72 0); DIMLIM (cons 73 0) ;DIMTIH-controls the position of dimension text inside extention lines ;METTE IL TESTO DI QUOTA ORIZZONTALE (cons 74 0) ;DIMTOH-controls the position of dimension text outside extention lines (cons 75 1); DIMSE1 ;1 sopprime la linea di estensione, 0 la lascia (cons 76 1); DIMSE2 ;1 sopprime la linea di estensione, 0 la lascia (cons 77 1) ;DIMTAD-controls the vertical position of text in relation to the dim line (cons 78 3) ;DIMZIN-controls the suppression of zeros (cons 79 1); DIMAZIN (cons 140 Text_Height) ;DIMTXT-specifies the height of the text in the dim (cons 141 Center_Mark_Size); DIMCEN (cons 142 0.0); DIMTSZ (cons 143 0.5) ;DIMALTF-controls the scale factor for alt. units (cons 144 quote_scale); DIMLFAC ;scala di quota (cons 145 0.0); DIMTVP (cons 146 0.64); DIMTFAC (cons 147 Gap_From_dimension_Line_to_Text) ;DIMGAP-sets the distance from around the dim text (cons 170 0); DIMALT (cons 171 2) ;DIMALTD-controls the decimal places for units (cons 172 0) ;DIMTOFL-forces a line inside extension lines (cons 173 1); DIMSAH (cons 174 0); DIMTIX (cons 175 0); DIMSOXD (cons 176 256); DIMCLRD (cons 177 256); DIMCLRE (cons 178 256); DIMCLRT color of text (cons 179 0); DIMADEC (cons 270 2) ;DIMUNIT-sets the units format for all dims ;2 decimale ; 4architettonico (cons 271 Decimal_Places) ;DIMDEC-sets the number of decimal places of primary units (cons 272 Tolerance_Decimal_places); DIMTDEC (cons 273 2) ;DIMALTU-sets the units for alt. units (cons 275 0) ;DIMAUNIT-sets the angular format for angular dims (cons 276 1); DIMFRAC (cons 277 2); DIMLUNIT ;2 decimale ; 4architettonico (cons 278 0); DIMDSEP (cons 279 Text_Movement); DIMTMOVE (cons 280 0) ;DIMJUST-controls the horizontal positioning of dim text (cons 281 -1); DIMSD1 (cons 282 -1); DIMSD2 (cons 283 1); DIMTOLJ (cons 284 3); DIMTZIN (cons 285 1); DIMALTZ (cons 286 0) ;DIMALTTZ-Toggles the suppression in tolerance values ;(cons 287 0); DIMFIT ;(cons 288 0); DIMUPT ;(cons 289 0); DIMATFIT (cons 340 (tblobjname "style" "Estilo_Cotas")); DIMTXSTY ;(cons 341 (cdr (assoc 330 (entget (tblobjname "block" "."))))); DIMLDRBLK ;(cons 342 (cdr (assoc 330 (entget(tblobjname "block" "_Oblique"))))); DIMBLK must setvar dimblk 1st ;(cons 343 (cdr (assoc 330 (entget(tblobjname "block" "_Oblique"))))); DIMBLK1 ;(cons 344 (cdr (assoc 330 (entget(tblobjname "block" "_Oblique"))))); DIMBLK2 ;(cons 371 -2); DIMLWD ;(cons 372 -2); DIMLWE Look at DIMCLRT maybe Google "DIMCLRT Autocad" go down a few suggestions look for the official Autodesk help.

Just tested mhupp's code and it looks like it's working just fine , well done mhupp

Using the title block instead of creating a viewport (defun c:Clean (/ ss tblk LL UR ss1 ss2) (command "_.Undo" "BE") (setvar 'cmdecho 0) (foreach lay (layoutlist) (setvar 'ctab lay) (command "_.Zoom" "E") (if (and (setq ss (ssget "_X" (list '(0 . "INSERT") '(2 . "GP1117_21" ) (cons 410 lay)))) (= (sslength ss) 1)) (progn (setq tblk (vlax-ename->vla-object (ssname ss 0))) (vla-GetBoundingBox tblk 'LL 'UR) (setq LL (vlax-safearray->list LL) UR (vlax-safearray->list UR) ) (if (and (setq ss1 (ssget "_A" (list (cons 410 lay)))) (setq ss2 (ssget "_W" LL UR (list (cons 410 lay))))) (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))) (ssdel ent ss1) ) ) (ssdel (ssname ss 0) ss1) (command "_.Erase" SS1 "") (command "_.Zoom" "E") ) ) ) (setvar 'cmdecho 1) (command "_.Undo" "E") (princ) )

Various comments. Not sure but Bricscad has Blockify that makes objects into blocks. You could get the outer boundary of the "arrows" which will be a pline and make a block then hatch. Another I think I have is draw an arrow which is 1 object. Just enter like start and end point. It may be a dynamic block. So just enter a couple of lengths and arrow is drawn.

Hi, Something along these codes? (defun c:Test ( / ss in en st) (if (setq ss (ssget "_:L" '((0 . "MTEXT")))) (repeat (setq in (sslength ss)) (setq en (entget (ssname ss (setq in (1- in)))) st (assoc 1 en)) (entmod (subst (cons 1 (strcat (cdr st) "p")) st en)) ) ) (princ) )

Thanks guys, Plenty for me to look over, and trial