All Activity

@SLW210 @HypnoS edited please test. cpy-blk-2-poly.lsp

@SLW210 please upload sample dwg , where yo did apply the lisp

you can make the routine show the number of selected texts and the number of attributes, please

I tried that everyway possible and no luck with AutoCAD 2026, if I get time I'll look through my settings again. Might be a quirk in my AutoCAD 2026. It does seem it used to work as you say.

I get Command: CPY-BLK-2-POLY Select objects: ; error: bad argument type: lselsetp nil

Here is my effort, worked on your drawing for me. ;;; Copy blocks to a polyline/line path in ascending order left to right based on ATTRIBUTE TAG value. | ;;; | ;;; https://www.cadtutor.net/forum/topic/98615-copy-blocks-to-curve-according-to-another-curve/#findComment-675378 | ;;; | ;;; By SLW210 (a.k.a. Steve Wilson) | ;;; | ;;;****************************************************************************************************************| ;| Lines/Polylines need be drawn Left-Right or reversed, could be coded to check direction and reverse them. I'm not motivated to do that, but feel free to alter the code. I did test on angled Polylines/Lines as well as vertical and it works, but might need adjustments. I adjusted a code I already had to handle this specific request for which it works, I doubt if I'll do anymore modifications. |; ;;;***************************************************************************************************************| ;;; This code asks to select the block and type in the tag name from options given (case sensitive). | ;;; | ;;;***************************************************************************************************************| (defun c:BlksSrt2PL (/ blkLst spacing pathEnt pathObj blkCopy len i param pt getAtVal parsFract attrVal blk startPt endPt dx dy visStart dist tangent rotAngle pathDist objType blkSelEnt blkSelObj tagList tagNames selTag ) (vl-load-com) ;; Function to get attribute value by tag name (defun getAtVal (blk tag / atts val) (setq atts (vlax-invoke blk 'GetAttributes)) (setq val "") (foreach att atts (if (= (strcase (vla-get-TagString att)) (strcase tag)) (setq val (vla-get-TextString att)) ) ) val ) ;; Function to convert fractional strings (like "1/2") to numbers (defun parsFract (s / pos num1 num2) (cond ((setq pos (vl-string-search "/" s)) (setq num1 (read (substr s 1 pos))) (setq num2 (read (substr s (+ pos 2)))) (if (and num1 num2 (/= num2 0)) (/ (float num1) num2) 0.0 ) ) ((distof s)) (T 0.0) ) ) ;; Select a block to determine attribute tag name (prompt "\nSelect a block to determine the tag name:") (setq blkSelEnt (car (entsel "\nSelect a block with attributes: "))) (if (not blkSelEnt) (progn (prompt "\nNo block selected. Exiting.") (exit) ) ) (setq blkSelObj (vlax-ename->vla-object blkSelEnt)) (if (not (vla-get-HasAttributes blkSelObj)) (progn (prompt "\nSelected block has no attributes. Exiting.") (exit) ) ) ;; Get all attribute tags from selected block (setq tagList '()) (foreach att (vlax-invoke blkSelObj 'GetAttributes) (setq tagList (cons (vla-get-TagString att) tagList)) ) (setq tagNames (apply 'strcat (mapcar '(lambda (x) (strcat "\n - " x)) tagList) ) ) (prompt (strcat "\nAvailable tags in selected block:" tagNames) ) (initget 1) (setq selTag (getstring "\nEnter the tag to use: ")) ;; --- Collect all blocks with that attribute tag --- (setq blkLst '()) (vlax-for ent (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-Acad-Object)) ) (if (and (= (vla-get-ObjectName ent) "AcDbBlockReference") (vla-get-HasAttributes ent) ) (progn (setq attrVal (getAtVal ent selTag)) (if (and attrVal (/= attrVal "")) (setq blkLst (cons (list (parsFract attrVal) ent) blkLst)) ) ) ) ) (if (= (length blkLst) 0) (progn (prompt "\nNo matching blocks found.") (exit) ) ) ;; Select path: polyline or line (prompt "\nSelect path (polyline or line): ") (setq pathEnt (car (entsel "\nSelect path (polyline or line): "))) (if (not pathEnt) (progn (prompt "\nNo object selected. Exiting.") (exit) ) ) (setq pathObj (vlax-ename->vla-object pathEnt)) (setq objType (vla-get-ObjectName pathObj)) (if (or (equal objType "AcDbPolyline") (equal objType "AcDbLine") ) (progn (setq startPt (vlax-curve-getStartPoint pathObj)) (setq endPt (vlax-curve-getEndPoint pathObj)) ) (progn (prompt (strcat "\nSelected object is not a polyline or line: " objType ". Exiting." ) ) (exit) ) ) ;; Determine start point (setq dx (- (car endPt) (car startPt))) (setq dy (- (cadr endPt) (cadr startPt))) (if (> (abs dy) (abs dx)) ;; Mostly vertical (setq visStart (if (> (cadr startPt) (cadr endPt)) startPt endPt ) ) ;; Mostly horizontal or diagonal (setq visStart (if (< (car startPt) (car endPt)) startPt endPt ) ) ) ;; Sort blocks by numeric tag value (setq blkLst (vl-sort blkLst (function (lambda (a b) (> (car a) (car b)))) ) ) (if (not (equal startPt visStart 1e-6)) (setq blkLst (reverse blkLst)) ) ;; Ask for spacing (initget 7) (setq spacing (getdist "\nEnter spacing between blocks: ")) ;; Place and rotate blocks along path (setq len (length blkLst)) (setq i 0) (setq dist 0.0) (setq pathDist (vlax-curve-getDistAtParam pathObj (vlax-curve-getEndParam pathObj) ) ) (while (and (< i len) (< dist pathDist)) (setq pt (vlax-curve-getPointAtDist pathObj dist)) (setq tangent (vlax-curve-getFirstDeriv pathObj (vlax-curve-getParamAtDist pathObj dist) ) ) (setq rotAngle (atan (cadr tangent) (car tangent))) ;; Flip angles to keep blocks upright (if (or (> rotAngle (/ pi 2)) (< rotAngle (- (/ pi 2)))) (setq rotAngle (+ rotAngle pi)) ) (if pt (progn (setq blk (cadr (nth i blkLst))) (setq blkCopy (vla-copy blk)) (vla-put-InsertionPoint blkCopy (vlax-3d-point pt)) (vla-put-Rotation blkCopy rotAngle) ) ) (setq dist (+ dist spacing)) (setq i (1+ i)) ) (prompt (strcat "\nCopied " (itoa i) " blocks along path.")) (princ) )

@BlackBox Thanks! (yeah - logand is fairly advanced, but shorter lol)

'... as simple'... using logand. (chortles) Teeheehee Props though, as yours allows arcs, etc... Well done

@BlackBox Beat me to the Punch! @james9710 Here is my version - as simple as I can make it: (defun C:PLH (/ e el) (command "._pline") (while (= (logand (getvar "cmdactive") 1) 1) (command pause) ) (if (and (setq e (entlast)) (setq el (entget e)) (= (cdr (assoc 0 el)) "LWPOLYLINE") (= (logand (cdr (assoc 70 el)) 1) 1) ) (command "._-hatch" "_pro" "_S" "_S" e "" "") (princ "\nInvalid Polyline Created (Must be complete and Closed).") ) (princ) )

Without using Visual LISP reactors, here's a starting point: (defun c:PLH (/ pt) (entlast) (command "._pline") (while (and (not (initget 32)) (if pt (setq pt (getpoint pt)) (setq pt (getpoint)) ) ) (command pt) ) (command "_c") (command "._-hatch" "_p" "_s" "_co" "." "." "_la" "." "_s" (ssadd (entlast)) "" "" ) (princ) )

@Mohamed Haytham Code updated to preserve global width.

@james9710 please upload your sample dwg where you will apply such lisp

@HypnoS Please show the command line text or error message.

hi, can someone please assist me on creating a lisp: create polyline then after closing, it will automatically create a solid hatch within the closed polyline. hatch should be solid and layer is as per current. command should be PLH big thanks. we are working on large scale landscape projects that need hatches of each area of soft scape and hardscape

It works, but the fence must pass on each side of the middle of the segment to be extended.

I just did a quick look in AutoCAD, this may be a bit tricky for me. Let me get my paid to do work done and I'll do more looking.

Try the code modified. If equal starting and ending widths or global width is define, the global width is individual set otherwise is ignored. Also takes into account the last segment if the polyline is closed as well as the generation of the linetype as well as the UCS of the original entity (defun c:break_lw ( / js i ent dxf_obj dxf_43 dxf_38 dxf_39 dxf_10 dxf_40 dxf_41 dxf_42 dxf_39 dxf_210 n) (initget "All Select") (if (eq (getkword "\nLWPolylines to break at each vertex? [All/Select] <Select>: ") "All") (setq js (ssget "_X" (list (cons 0 "LWPOLYLINE") (cons 67 (if (eq (getvar "CVPORT") 2) 0 1)) (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB"))) ) ) i -1 ) (setq js (ssget (list (cons 0 "LWPOLYLINE") (cons 67 (if (eq (getvar "CVPORT") 2) 0 1)) (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB"))) ) ) i -1 ) ) (cond (js (repeat (sslength js) (setq dxf_obj (entget (setq ent (ssname js (setq i (1+ i)))))) (if (cdr (assoc 43 dxf_obj)) (setq dxf_43 (cdr (assoc 43 dxf_obj))) (setq dxf_43 nil) ) (if (cdr (assoc 38 dxf_obj)) (setq dxf_38 (cdr (assoc 38 dxf_obj))) (setq dxf_38 0.0) ) (if (cdr (assoc 39 dxf_obj)) (setq dxf_39 (cdr (assoc 39 dxf_obj))) (setq dxf_39 0.0) ) (setq dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_obj)) dxf_40 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 40)) dxf_obj)) dxf_41 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 41)) dxf_obj)) dxf_42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) dxf_obj)) dxf_210 (cdr (assoc 210 dxf_obj)) ) (if (not (zerop (boole 1 (cdr (assoc 70 dxf_obj)) 1))) (setq dxf_10 (append dxf_10 (list (car dxf_10))) dxf_40 (append dxf_40 (list (car dxf_40))) dxf_41 (append dxf_41 (list (car dxf_41))) dxf_42 (append dxf_42 (list (car dxf_42))) n (cdr (assoc 90 dxf_obj)) ) (setq n (1- (cdr (assoc 90 dxf_obj)))) ) (repeat n (entmake (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (assoc 67 dxf_obj) (assoc 410 dxf_obj) (assoc 8 dxf_obj) (if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256)) (if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER")) (if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1)) (cons 100 "AcDbPolyline") (cons 90 2) (cons 70 (boole 1 (cdr (assoc 70 dxf_obj)) 128)) (cons 38 dxf_38) (cons 39 dxf_39) (cons 10 (car dxf_10)) ) (cond (dxf_43 (list (cons 43 dxf_43) (cons 40 dxf_43) (cons 41 dxf_43) ) ) ((equal (car dxf_40) (car dxf_41)) (list (cons 43 (car dxf_40)) (cons 40 (car dxf_40)) (cons 41 (car dxf_41)) ) ) (T (list (cons 40 (car dxf_40)) (cons 41 (car dxf_41)) ) ) ) (list (cons 42 (car dxf_42)) (cons 10 (cadr dxf_10)) ) (cond (dxf_43 (list (cons 43 dxf_43) (cons 40 dxf_43) (cons 41 dxf_43) ) ) ((equal (car dxf_40) (car dxf_41)) (list (cons 43 (car dxf_40)) (cons 40 (car dxf_40)) (cons 41 (car dxf_41)) ) ) (T (list (cons 40 (car dxf_40)) (cons 41 (car dxf_41)) ) ) ) (list (cons 42 (cadr dxf_42)) (assoc 210 dxf_obj) ) ) ) (setq dxf_10 (cdr dxf_10) dxf_40 (cdr dxf_40) dxf_41 (cdr dxf_41) dxf_42 (cdr dxf_42)) ) (entdel ent) ) (print (sslength js)) (princ " LWpolyline(s) breaked at its vertexs.") ) ) (prin1) )

If a polyline consists of several segments and they have different widths, then the global width is not defined in the properties. If a polyline from the same segment has different starting and ending widths, then the global width is also not defined in the properties. The global width in the properties is displayed only for a polyline of several segments of the same width or a polyline of the same segment with the same starting and ending widths. If you want to set the same global width of the polylines, simply select all the polylines and set the desired width in the properties. Or did I misunderstand what you want to do?..

@devitg Yours seams to not work for me at all @BIGAL I can't quite go through this routine to see final result. nothing happens after i daw a line. Also I already have a polyline that goes though all blocks that I need, so the part in lisp that tells me to draw line over blocks is unnecessary To be more precise. Lisp CopyBlockstocurve works great, the only part i want to change is that I dont want to click on each block to copy it to straight line. I want them to be copied automaticlly acording to pline that is existing

Thanks all for providing different lisps. All worked perfect in terms of breaking the poly, but I have one small issue, the global width is remained undefined. Is there a way even with a different lisp to assign the Global width from the start / End segment width?

Another give it a try. ; https://www.cadtutor.net/forum/topic/98615-copy-blocks-to-curve-according-to-another-curve/ ; get blocks along a pline at any XY then redo as a straight line. ; By AlanH July 2025 (defun c:wow ( / bname co-ord ent obj plent pt spac ss x) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq plent (car (entsel "\pick pline joining blocks "))) (setq obj (vlax-ename->vla-object (car (entsel "\nPick block object ")))) (setq pt (getpoint "\nPick left point ")) (setq spac (getreal "\Enter spacing ")) (setq bname (vlax-get obj 'effectivename)) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget plent)))) (setq ss (ssget "F" co-ord '((0 . "INSERT")))) (command "line" pt (mapcar '+ pt (list (* (- (sslength ss) 1) spac) 0.0 0.0)) "") (repeat (setq x (sslength ss)) (setq ent (ssname ss (setq x (- x 1)))) (setq obj (vlax-ename->vla-object ent)) (if (= (vlax-get obj 'effectivename) bname) (progn (command "copy" ent "" (vlax-get obj 'Insertionpoint) pt) (setq pt (mapcar '+ pt (list spac 0.0 0.0))) ) ) ) (princ) )

If you have a reference point X&Y in metres and in feet then you can move the dwg to that point and apply a scale factor. 1 foot = 0.3048 m. There may be a conversion program for where you are in the world, feet to metres converting a point XY. It is easy to do a direct conversion but often with Geo stuff scale factors, world zones and so forth creep in. X=259975.41 Y=5129431.27 Z=0.00 : (/ 259975.41 0.3048) 852937.696850394

@HypnoS Please give it a try cpy-blk-2-poly.lsp

As the drawing has Geomap, it is not converting from M to Ft. Can't use scale, -dwgunits, Classicinsert too. Is there an y lisp to convert without changing position? as layout and Geomap is there. HM25E - Permit & Design 1.dwg

I know he uses BricsCAD and I used it for the last 5 years when I was still working in CAD. liked it a lot more the AutoCAD. there are differences but mostly for the better like double extend.