All Activity
- Past hour
-
;BACALADO DE BILBADOOO (PLUS) (defun nqf (tuSS / i lista tipObj cant cad txs atts) (princ "\nNumero que falta") (terpri) (if tuSS (setq cant (sslength tuSS)) (progn (alert "No existe conjunto de seleccion o esta vacio") (exit) ) ) (princ "\nCantidad de textos seleccionados = ") (princ cant) (princ "\nLista de numeros faltantes") ;Pasar del SS a una lista de valores (setq i 0 txs 0 atts 0) (repeat (sslength tuSS) (setq tipObj (cdr (assoc 0 (setq le (entget (ssname tuSS i))))) num (atoi (cdr (assoc (if (= tipObj "TEXT") 1 2) le))) i (1+ i) lista (if (setq l (assoc num lista)) (subst (list num (1+ (cadr l))) l lista) (append lista (list (list num 1))) ) ) (if (= tipObj "TEXT") (setq txs (+ txs 1)) (setq atts (+ atts 1))) ) ;Imprimir los valores que no aparezcan (terpri) (setq i 1) (princ (strcat "\nLista de numeros existentes\n" (while lista (if (setq v (assoc i lista)) (setq cad (if (= (cadr v) 1) (if cad (strcat cad ", " (itoa (car v))) (itoa (car v)) ) (if cad (strcat cad ", " (itoa (car v)) "(" (itoa (cadr v)) ")") (strcat (itoa (car v)) "(" (itoa (cadr v)) ")") ) ) lista (vl-remove v lista) ) (princ (strcat "\nFalta el # " (itoa i))) ) (setq i (1+ i)) cad ) "\nTextos: " (itoa txs) "\nAtributos: " (itoa atts) ) ) (princ) ) (defun c:nqf nil (nqf (ssget '((0 . "TEXT,ATTDEF")))))
-
Copy blocks to curve according to another curve
devitg replied to HypnoS's topic in AutoLISP, Visual LISP & DCL
@SLW210 it ask for the polyline where the blocks are inserted, then get the coordinates from such polyline , and use it to get all blocks as selectionset . It draw a polyline straight long enough to receive the new block at a given distance, 1000 units in this cas Then it copy each one and move to the new line- 15 replies
-
- autolisp
- block position
-
(and 3 more)
Tagged with:
-
Copy blocks to curve according to another curve
SLW210 replied to HypnoS's topic in AutoLISP, Visual LISP & DCL
Your latest works in AutoCAD 2000i on my home computer, though it makes a new line was that intended? I like yours a lot.- 15 replies
-
- autolisp
- block position
-
(and 3 more)
Tagged with:
- Today
-
Copy blocks to curve according to another curve
SLW210 replied to HypnoS's topic in AutoLISP, Visual LISP & DCL
I used the one supplied by the OP.- 15 replies
-
- autolisp
- block position
-
(and 3 more)
Tagged with:
-
baker started following Dynamic Block w/Rotation and Stretch
-
Dynamic Block w/Rotation and Stretch
baker replied to Bill Tillman's topic in AutoCAD Drawing Management & Output
Holy Old Post bump!!!! Yeah i was looking to do just this today.. totally forgot how... thanks to this thread.. i figured it out. Use the POLAR parameter, start point at the center of rotation, end point at the point you want the stretch to end. Add the POLAR STRETCH action to the SECOND point. Select the objects you want to stretch, like the line and end arrow. Select the object you want to rotate, like the line, end arrow and the triangular arrow near the circle. Boom Done Bob's your Uncle. DynBlock101.dwg -
Copy blocks to curve according to another curve
devitg replied to HypnoS's topic in AutoLISP, Visual LISP & DCL
@SLW210 @HypnoS edited please test. cpy-blk-2-poly.lsp- 15 replies
-
- 1
-
-
- autolisp
- block position
-
(and 3 more)
Tagged with:
-
Copy blocks to curve according to another curve
devitg replied to HypnoS's topic in AutoLISP, Visual LISP & DCL
@SLW210 please upload sample dwg , where yo did apply the lisp- 15 replies
-
- 1
-
-
- autolisp
- block position
-
(and 3 more)
Tagged with:
-
you can make the routine show the number of selected texts and the number of attributes, please
-
How to Extend Lines to shape 2D Polyline
SLW210 replied to Mountain_XD's topic in AutoLISP, Visual LISP & DCL
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. -
Copy blocks to curve according to another curve
SLW210 replied to HypnoS's topic in AutoLISP, Visual LISP & DCL
I get Command: CPY-BLK-2-POLY Select objects: ; error: bad argument type: lselsetp nil- 15 replies
-
- autolisp
- block position
-
(and 3 more)
Tagged with:
-
Copy blocks to curve according to another curve
SLW210 replied to HypnoS's topic in AutoLISP, Visual LISP & DCL
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) )- 15 replies
-
- autolisp
- block position
-
(and 3 more)
Tagged with:
-
closed polyline with automatic hatch
pkenewell replied to james9710's topic in AutoLISP, Visual LISP & DCL
@BlackBox Thanks! (yeah - logand is fairly advanced, but shorter lol) -
closed polyline with automatic hatch
BlackBox replied to james9710's topic in AutoLISP, Visual LISP & DCL
'... as simple'... using logand. (chortles) Teeheehee Props though, as yours allows arcs, etc... Well done -
pkenewell started following closed polyline with automatic hatch
-
closed polyline with automatic hatch
pkenewell replied to james9710's topic in AutoLISP, Visual LISP & DCL
@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) ) -
BlackBox started following closed polyline with automatic hatch
-
closed polyline with automatic hatch
BlackBox replied to james9710's topic in AutoLISP, Visual LISP & DCL
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) ) -
Break Polyline at different depth
ronjonp replied to Mohamed Haytham's topic in AutoLISP, Visual LISP & DCL
-
devitg started following closed polyline with automatic hatch
-
closed polyline with automatic hatch
devitg replied to james9710's topic in AutoLISP, Visual LISP & DCL
@james9710 please upload your sample dwg where you will apply such lisp -
Copy blocks to curve according to another curve
devitg replied to HypnoS's topic in AutoLISP, Visual LISP & DCL
@HypnoS Please show the command line text or error message.- 15 replies
-
- autolisp
- block position
-
(and 3 more)
Tagged with:
-
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
-
How to Extend Lines to shape 2D Polyline
Tsuky replied to Mountain_XD's topic in AutoLISP, Visual LISP & DCL
It works, but the fence must pass on each side of the middle of the segment to be extended. -
How to Extend Lines to shape 2D Polyline
SLW210 replied to Mountain_XD's topic in AutoLISP, Visual LISP & DCL
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. -
Break Polyline at different depth
Tsuky replied to Mohamed Haytham's topic in AutoLISP, Visual LISP & DCL
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) ) -
Break Polyline at different depth
Nikon replied to Mohamed Haytham's topic in AutoLISP, Visual LISP & DCL
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?.. -
Copy blocks to curve according to another curve
HypnoS replied to HypnoS's topic in AutoLISP, Visual LISP & DCL
@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- 15 replies
-
- autolisp
- block position
-
(and 3 more)
Tagged with:
-
Break Polyline at different depth
Mohamed Haytham replied to Mohamed Haytham's topic in AutoLISP, Visual LISP & DCL
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?