Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation since 01/20/2025 in all areas

  1. Here's my take on it: (defun c:foo (/ lm:unformat b el p r s sp tx) (cond ((setq s (ssget ":L" '((0 . "CIRCLE")))) (cond ((null (tblobjname "block" "Bubble")) (entmake '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (66 . 1) (2 . "Bubble") (10 0. 0. 0.) (70 . 2) ) ) (entmake '((0 . "CIRCLE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbCircle") (10 0. 0. 0.) (40 . 1.) ) ) (entmake '((0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbText") (10 0. 0. 0.) (40 . 0.75) (1 . "") (50 . 0) (41 . 1) (51 . 0) (7 . "Standard") (71 . 0) (72 . 1) (11 0. 0. 0.) (100 . "AcDbAttributeDefinition") (280 . 0) (3 . "") (2 . "#") (70 . 8) (73 . 0) (74 . 2) (280 . 1) ) ) (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0"))) ) (command "_.ATTSYNC" "_NAME" "BUBBLE") ) ;;-------------------=={ UnFormat String }==------------------;; ;; ;; ;; Returns a string with all MText formatting codes removed. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; str - String to Process ;; ;; mtx - MText Flag (T if string is for use in MText) ;; ;;------------------------------------------------------------;; ;; Returns: String with formatting codes removed ;; ;;------------------------------------------------------------;; (defun lm:unformat (str mtx / _replace rx) (defun _replace (new old str) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new) ) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda () (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '(("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]" ) ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str) ) (_replace "\\" "\032" str) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) (setq sp (vlax-ename->vla-object (cdr (assoc 330 (entget (ssname s 0)))))) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (setq r (/ (cdr (assoc 40 (setq el (entget e)))) 2.)) (setq p (cdr (assoc 10 el))) (cond ((setq tx (ssget "_C" (mapcar '- p (list r r r)) (mapcar '+ p (list r r r)) '((0 . "*TEXT"))) ) (setq r (* 2 r)) (setq b (vla-insertblock sp (vlax-3d-point p) "Bubble" r r r 0.)) (vla-put-textstring (car (vlax-invoke b 'getattributes)) (lm:unformat (cdr (assoc 1 (entget (ssname tx 0)))) nil) ) (entmod (append (entget (vlax-vla-object->ename b)) '((8 . "BUBBLE")))) (entdel e) (entdel (ssname tx 0)) ) ) ) ) ) (princ) )
    4 points
  2. @pondpepo9 I can't tell you if what you are looking for exists unless you can be more specific on what you want. Ideally, post a DWG with the Before and After and explain in more detail what the workflow should be. Then if someone has something they are willing to share, write, or alter - we can let you know. PLEASE NOTE: This is not a forum just to order up free programs. We prefer helping those who wish to learn programming and need a place to start, which is the purpose of this forum.
    3 points
  3. I edited something at the last minute. You may need to copy the code again
    2 points
  4. Join worked with selection sets or it did in BricsCAD, but They have to be touching. quick googling you have to use the first entity in the selection set to "continue the command" then call the selection set. (command "_.join" (ssname sset1 0) "_J" sset1 "_Y") Use entmake way instead its much cleaner. -Edit Might want to make the rise and tread dynamic (defun C:FOO (/ SPT EPT RPT TPT ptlst) (setq SPT (getpoint "\nEnter Start Point: ") EPT (getpoint "\nEnter Top of First Stair: ") RoR (mapcar '- SPT EPT) ;Rise over Run from SPT to EPT R1 (polar SPT 0 (cadr RoR))) ptlst (append ptlst (list SPT R1)) ) (repeat 6 (setq RPT (polar r1 (* pi 0.5) (car RoR))) (setq TPT (polar r1 0 (cadr RoR))) (setq ptlst (append ptlst (list RPT TPT))) (setq RPT TPT) )
    2 points
  5. Quick testing, join wants individual entities and not a selection set: use (ssname sset1 0) (ssname sset1 1)... instead of sset1 Alternative would be record all the points in a list and entmake the polyline using these points or (command pline.... ) with all the points for all the stair EDIT: Following your code, this uses the entmake method: (defun c:test ( / s1 points r1 t1 newpoly) (setq t1 (getpoint "\nEnter first insertion point: ")) ; Get insertion point (setq points (list t1)) ; Create a list of points (repeat 6 ; repeat n times (6) (setq r1 (polar t1 (* pi 0.5) 0.15)) ; riser calculation (setq t1 (polar r1 0 0.3)) ; tread calculation (setq points (append points (list r1))) ; add riser point to list of points (setq points (append points (list t1))) ; add tread point to list of points ) (setq newpoly (entmakex (append (list ; create a polyline from list of points (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length points)) (cons 70 0)) (mapcar (function (lambda (p) (cons 10 p))) points)) )) ; end setq, end entmakex (princ) ; exit quietly )
    2 points
  6. Sorry, I issued a warning and deleted the offending post.
    2 points
  7. Modified for 'dimaligned' and 'dimlinear'. Give it a go. I haven't tested it thoroughly. Do it for me (defun c:agrupaDIMs (/ n conj ent lstent pt pt1 pt2 ptIni ptFin desplz desplzX desplzY punto tamTX gapTX desplzMax osmant ang ptTx1 ptTx2 params escala rotDIM ) (setq n 0 osmant (getvar "OSMODE") ) (setvar "OSMODE" 0) (if (setq conj (ssget '((0 . "DIMEN*")))) (progn (while (setq ent (ssname conj n)) (setq pt1 (cdr (assoc 13 (setq lstent (entget ent)))) pt2 (cdr (assoc 14 lstent)) ptTx1 (cdr (assoc 10 lstent)) ptTx2 (if (setq rotDIM (= (cdr (last lstent)) "AcDbRotatedDimension")) (if (< (abs (- (cadr pt2) (cadr ptTx1))) 0.0001) (list (car ptTx1) (cadr pt1));o sea, acotación tumbada (list (car pt1) (cadr ptTx1));o sea, acotación levantada de arriba abajo o viceversa ) (polar pt1 (angle pt2 ptTx1) (distance pt2 ptTx1)) ) ang (angle pt2 (cdr (assoc 10 lstent))) tamTX (vlax-get-property (vlax-ename->vla-object ent) "TextHeight" ) gapTX (vlax-get-property (vlax-ename->vla-object ent) "TextGap" ) escala (vlax-get-property (vlax-ename->vla-object ent) "ScaleFactor" ) desplz (+ (* tamTX escala) gapTX) ) (if (not params) (setq params (list tamTX (vlax-get-property (vlax-ename->vla-object ent) 'ArrowheadSize))) ) (if desplzMax (setq desplzMax (max desplzMax desplz)) (setq desplzMax desplz) ) (if (< (car ptTx2) (car ptTx1)) (setq pt ptTx1 ptTx1 ptTx2 ptTx2 pt ) (if (= (car ptTx2) (car ptTx1)) (if (< (cadr ptTx2) (cadr ptTx1)) (setq pt ptTx1 ptTx1 ptTx2 ptTx2 pt ) ) ) ) (if ptIni (if (and (/= (car ptTx2) (car ptTx1)) (< (car ptTx1) (car ptIni)) ) (setq ptIni ptTx1) (if (= (car ptTx1) (car ptTx2)) (if (< (cadr ptTx1) (cadr ptIni)) (setq ptIni ptTx1) ) ) ) (setq ptIni ptTx1) ) (if ptFin (if (and (/= (car ptTx2) (car ptTx1)) (> (car ptTx2) (car ptFin)) ) (setq ptFin ptTx2) (if (= (car ptTx2) (car ptTx2)) (if (> (cadr ptTx2) (cadr ptFin)) (setq ptFin ptTx2) ) ) ) (setq ptFin ptTx2) ) (setq n (+ n 1)) ) (setq punto (polar ptIni (angle ptIni ptFin) (/ (distance ptIni ptFin) 2.0) ) punto (polar punto ang (* desplzMax 2.0)) ) (if rotDIM (vl-cmdf "_dimlinear" ptIni ptFin punto) (vl-cmdf "_dimaligned" ptIni ptFin punto) ) (vlax-put-property (vlax-ename->vla-object (entlast)) 'TextHeight (* (car params) escala)) (vlax-put-property (vlax-ename->vla-object (entlast)) 'ArrowheadSize (* (cadr params) escala)) (setvar "OSMODE" osmant) ) ) (princ) )
    2 points
  8. I have started again with this and started making defuns for each type of task. A start, making defuns rather than just code. See updated code below
    2 points
  9. (defun c:foo (/ ss selPt obj startPt endPt pt1) (while (not ss) (setq ss (ssget "_+.:E:S" '((0 . "LINE")))) ) (setq selPt (trans (cadr (nth 3 (car (ssnamex ss 0)))) 0 2)) ; get point of selection (setq obj (vlax-ename->vla-object (ssname ss 0))) (setq startPt (reverse (cdr (reverse (trans (vlax-curve-getStartPoint obj) 0 2))))) (setq endPt (reverse (cdr (reverse (trans (vlax-curve-getEndPoint obj) 0 2))))) ;; Determine closer endpoint (if (< (distance selPt startPt) (distance selPt endPt)) (setq pt1 startPt) (setq pt1 endPt) ) (vla-put-color (vla-addcircle (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (trans pt1 2 0)) 10) acRed) ;circle for testing ) Hi EnM4st3r, Try the edited code above if it works for you.
    2 points
  10. This is where I started there is info out there but a bit hard to find. The zip has lisp and vba example it is just in one file for my convenience as I cut and paste from it. https://www.cadtutor.net/forum/topic/79565-autocad-use-libreoffice-instead-of-excel/page/3/ Get and Put data into Libreoffice Calc — BricsCAD Forum https://forum.bricsys.com/discussion/38699/get-and-put-data-into-libreoffice-calc?utm_source=community-search&utm_medium=organic-search&utm_term=libre Look at Tim_n post. The main thing is start here. (setq oServiceManager (vlax-get-or-create-object "com.sun.star.ServiceManager")) Best to reply to my original post rather than here. Put back into my To do list. Libre.zip
    2 points
  11. Try changing this line : (setq gap (getvar "dimtxt")) To this line : (setq gap (* 2.0 (getvar "dimtxt")))
    2 points
  12. I am on holidays back tomorrow will have a look at it
    2 points
  13. Also, if the "MTEXT" is, you can select all desired "MTEXT" and from "PROPERTIES" tab, select "Text frame". That is the easiest way to do and make a boundary around text. If the "TEXT" is, you can use a built-in function in CAD "TXT2MTXT", select all "TEXT" entities and convert it in "MTEXT" and than add a frame.
    2 points
  14. Here is the little modification that was missing: you already have the functionality But you should simplify the code a bit. One test you could do is to obtain the triangles using minimum circles to compare the differences. Do your tests (defun SX:M3DFACEF3DPL (/ enameOne enameSecond old_layer layerNameBase dataOne ptOne ptlistOne dataSecond ptSecond ptlistSecond len i j pt1 pt2 pt3 ind1 ind2 decideTRI ang_sub_ref ) (defun decideTRI (/ a b c d pt1Lst1 pt2Lst1 pt1Lst2 pt2Lst2 selecTRIbase->Lista1 selecTRIbase->Lista2 TRI_transgresor? ) (defun selecTRIbase->Lista1 () (setq pt1 pt1Lst1 pt2 pt2Lst1 pt3 pt1Lst2 ind1 (+ ind1 1) ) ) (defun selecTRIbase->Lista2 () (setq pt1 pt1Lst2 pt2 pt2Lst2 pt3 pt1Lst1 ind2 (+ ind2 1) ) ) (defun TRI_transgresor? (pt2 pt3 / lst1 lst2 n m pto1 pto2 lista para val ind pt2D) (defun pt2D (pt3D) (list (car pt3D) (cadr pt3D)) ) (setq pt2 (polar (pt2D pt2) (angle pt2 pt3) 0.01) pt3 (polar (pt2D pt3) (angle pt3 pt2) 0.01) lst1 (foreach ind '(-2 -1 0 1 2) (if (and (not (minusp (+ ind1 ind))) (setq val (nth (+ ind1 ind) ptlistOne)) ) (setq lst1 (append lst1 (list (pt2D val)))) ) ) lst2 (foreach ind '(-2 -1 0 1 2) (if (and (not (minusp (+ ind2 ind))) (setq val (nth (+ ind2 ind) ptlistSecond)) ) (setq lst2 (append lst2 (list (pt2D val)))) ) ) ) (setq m 0) (while (and (not para) (setq lista (nth m (list lst1 lst2)))) (setq n 0) (while (and (not para) (setq pto2 (nth (+ n 1) lista))) (setq pto1 (nth n lista)) (if (inters pt2 pt3 pto1 pto2) (setq para T) ) (setq n (+ n 1)) ) (setq m (+ m 1)) ) para ) (setq pt1Lst1 (nth ind1 ptlistOne) pt2Lst1 (nth (1+ ind1) ptlistOne) pt1Lst2 (nth ind2 ptlistSecond) pt2Lst2 (nth (1+ ind2) ptlistSecond) ) (if (and pt1Lst1 pt2Lst1 pt1Lst2 pt2Lst2) (if (= (min (setq a (abs (- (abs (ang_sub_ref (nth ind1 ptlistOne) (nth (1+ ind1) ptlistOne) (nth ind2 ptlistSecond) ) ) (/ pi 2.0) ) ) ) (setq b (abs (- (abs (ang_sub_ref (nth ind2 ptlistSecond) (nth (1+ ind2) ptlistSecond) (nth ind1 ptlistOne) ) ) (/ pi 2.0) ) ) ) ) a ) (if (not (TRI_transgresor? pt2Lst1 pt1Lst2)) (selecTRIbase->Lista1) (selecTRIbase->Lista2) ) (if (not (TRI_transgresor? pt2Lst2 pt1Lst1)) (selecTRIbase->Lista2) (selecTRIbase->Lista1) ) ) (setq lst (list pt1Lst1 pt2Lst1 pt1Lst2 pt2Lst2) lst (vl-remove nil lst) ind1 (+ ind1 10) ind2 (+ ind2 10) pt1 (nth 0 lst) pt2 (nth 1 lst) pt3 (nth 2 lst) ) ) ) (defun ang_sub_ref (pta ptb pt1 / ang_result ang_ref ang ang_desde_ptb) (setq ang_ref (angle pta ptb) ang_desde_ptb (angle ptb pt1) ) (cond ((< (abs (setq ang (- ang_ref ang_desde_ptb))) PI) ang ) ((and (> (abs (setq ang (- ang_ref ang_desde_ptb))) PI) (<= ang_ref PI) ) (+ ang_ref (- (* 2 PI) ang_desde_ptb)) ) ((and (> (abs (setq ang (- ang_ref ang_desde_ptb))) PI) (> ang_ref PI) ) (- (- ang_ref (* 2 PI)) ang_desde_ptb) ) (T (princ "\n***Caso no esperado en ang_sub_ref") ) ) ) ;;; (command-s "_UNDO" "BE") (setq enameOne (car (entsel "\nSelect the first 3DPOLYLINE:")) enameSecond (car (entsel "\nSelect the second 3DPOLYLINE:")) ) (while (or (= enameOne nil) (not (= "POLYLINE" (cdr (assoc 0 (entget enameOne))))) ) (if (= enameOne nil) (progn (prompt "\nNothing was selected. Try again...") (setq enameOne (car (entsel "\nSelect the first 3DPOLYLINE:"))) (princ) ) (progn (prompt "\nSelected entity must be 3DPOLYLINE. Try again..." ) (setq enameOne (car (entsel "\nSelect the first 3DPOLYLINE:"))) (princ) ) ) ) (while (or (= enameSecond nil) (not (= "POLYLINE" (cdr (assoc 0 (entget enameSecond))))) ) (if (= enameSecond nil) (progn (prompt "\nNothing was selected. Try again...") (setq enameSecond (car (entsel "\nSelect the second 3DPOLYLINE:")) ) (princ) ) (progn (prompt "\nSelected entity must be 3DPOLYLINE. Try again..." ) (setq enameSecond (car (entsel "\nSelect the second 3DPOLYLINE:")) ) (princ) ) ) ) (setq old_layer (getvar 'clayer) layerNameBase (cdr (assoc 8 (entget enameOne))) ) (setvar 'clayer layerNameBase) ;;; (setq objOne (vlax-ename->vla-object enameOne) ;;; objSecond (vlax-ename->vla-object enameOne) ;;; ) (setq dataOne (entget enameOne)) (while (/= (cdr (assoc 0 dataOne)) "SEQEND") (setq ptOne (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dataOne) ) ) (if (/= (nth 0 (nth 0 ptOne)) 0.0) (setq ptlistOne (cons ptOne ptlistOne)) ) (setq dataOne (entget (entnext (cdr (assoc -1 dataOne))))) ) (setq ptlistOne (mapcar 'car ptlistOne)) ; lista de puntos de la primera polil铆nea 3D (setq dataSecond (entget enameSecond)) (while (/= (cdr (assoc 0 dataSecond)) "SEQEND") (setq ptSecond (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dataSecond ) ) ) (if (/= (nth 0 (nth 0 ptSecond)) 0.0) (setq ptlistSecond (cons ptSecond ptlistSecond)) ) (setq dataSecond (entget (entnext (cdr (assoc -1 dataSecond))))) ) (setq ptlistSecond (mapcar 'car ptlistSecond)) ; lista de puntos de la segunda polil铆nea 3D (setq ptlistOne (reverse ptlistOne)) (setq ptlistSecond (reverse ptlistSecond)) ;;; (if (> (length ptlistOne) (length ptlistSecond)) ;;; (progn ;;; (setq len (length ptlistOne) ;;; i 0 ;;; j 0 ;;; ) ;;; ) ;;; (progn ;;; (setq len (length ptlistSecond) ;;; i 0 ;;; j 0 ;;; ) ;;; ) ;;; ) ;;; (while (< i len) ;;; (if (/= (nth (1+ i) ptlistOne) nil) ;;; (entmake (list (cons 0 "3DFACE") ;;; (cons 10 (nth i ptlistOne)) ;;; (cons 11 (nth j ptlistSecond)) ;;; (cons 12 (nth (1+ i) ptlistSecond)) ;;; (cons 13 (nth i ptlistOne)) ;;; ) ;;; ) ;;; ) ;;; (if (and (/= (nth (1+ i) ptlistOne) nil) ;;; (/= (nth (1+ j) ptlistSecond) nil) ;;; ) ;;; (entmake (list (cons 0 "3DFACE") ;;; (cons 10 (nth (1+ i) ptlistOne)) ;;; (cons 11 (nth (1+ j) ptlistSecond)) ;;; (cons 12 (nth i ptlistOne)) ;;; (cons 13 (nth (1+ i) ptlistOne)) ;;; ) ;;; ) ;;; ) ;;; (setq i (1+ i) ;;; j (1+ j) ;;; ) ;;; ) (setq ind1 0 ind2 0 ) (while (and (nth ind1 ptlistOne) (nth ind2 ptlistSecond) (or (nth (1+ ind1) ptlistOne) (nth (1+ ind2) ptlistSecond)) ) (decideTRI) (entmake (list (cons 0 "3DFACE") (cons 10 pt1) (cons 11 pt2) (cons 12 pt3) (cons 13 pt1) ) ) ;;; (getstring "\nPulsa INTRO") ) (setvar 'clayer old_layer) ;;; (command-s "_UNDO" "E") (princ) )
    2 points
  15. @GLAVCVS gracias, now the number of circles is counted only inside the contour.
    1 point
  16. (defun c:Circles_Chess_outl (/ oddp ent step radius vlist minx miny maxx maxy x y row pt osmant circulos creaMTEXT ) ;;----------------------------------------------- ;; THE FUNCTION OF CHECKING WHETHER THE NUMBER IS ODD ;;----------------------------------------------- (defun oddp (n) (= (logand (fix n) 1) 1) ) ;;----------------------------------------------- ;; Local auxiliary functions ;;----------------------------------------------- ;; Extracting a list of vertices (points) of a linear 2D polyline: (defun getPolyVertices (e / ed lst pts) (setq ed (entget e) ;; selecting all groups of the DXF = 10 code (coordinates of the vertices) lst (vl-remove-if-not '(lambda (x) (= (car x) 10)) ed ) ;; turning them into a regular list of points (x y) pts (mapcar 'cdr lst) ) (if (vlax-get-property (vlax-ename->vla-object e) "Closed") (append pts (list (car pts))) pts ) ) ;; Checking whether the pt point is located inside the linear polygon v list: ;;; (defun pointInPolygon (pt vlist / cnt i v1 v2) ;;; (setq cnt 0 ;;; i 0 ;;; ) ;;; ;; "Let's "block" the list so that we can bypass the pair (list[i], list[i+1]): ;;; (setq vlist (append vlist (list (car vlist)))) ;;; (repeat (1- (length vlist)) ;;; (setq v1 (nth i vlist) ;;; v2 (nth (1+ i) vlist) ;;; i (1+ i) ;;; ) ;;; (if (edgeIntersectsRay pt v1 v2) ;;; (setq cnt (1+ cnt)) ;;; ) ;;; ) ;;; ;; If the number of intersections with the ray is odd, the point inside ;;; (if (= (logand cnt 1) 1) ;;; T ;;; nil ;;; ) ;;; ) (defun comprobar_centralidad (pto lst_ptos_rto / pt_inters+ pt_inters- n pt1 pt2 inters_negat inters_posit ) (setq n 0) (repeat (- (length lst_ptos_rto) 1) (setq pt_inters+ (inters pto (list (+ (car pto) 100000) (cadr pto)) (setq pt1 (nth n lst_ptos_rto)) (setq pt2 (nth (+ n 1) lst_ptos_rto)) ) ) (if (and pt_inters+ (not (member (cons 10 pt_inters+) lst_ptos_rto)) ) (if inters_posit (setq inters_posit (+ inters_posit 1)) (setq inters_posit 1) ) ) (setq pt_inters- (inters pto (list (- (car pto) 100000) (cadr pto)) pt1 pt2 ) ) (if (and pt_inters- (not (member (cons 10 pt_inters-) lst_ptos_rto)) ) (if inters_negat (setq inters_negat (+ inters_negat 1)) (setq inters_negat 1) ) ) (setq n (+ n 1)) ) ;;; (print (list (strcat "Punto: " (rtos (car pto) 2 2) "," (rtos (cadr pto) 2 2)) inters_negat inters_posit)) (if (and (= (rem (if (not inters_negat) 0 inters_negat ) 2 ) 0 ) (= (rem (if (not inters_posit) 0 inters_posit ) 2 ) 0 ) ) nil T ) ) (defun creaMTEXT (texto altura / vlaEnt) (setq vlaEnt (vla-AddMText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point ptx) 50 texto)) (vlax-put-property vlaEnt "Height" altura) ) (defun creaCIRCULO (pto radio / vlaEnt) (setq vlaEnt (vla-AddCircle (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point pto) radio)) ) ;; Checking the intersection of the horizontal ray to the right of pt with the segment (v1,v2): (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2) (setq px (car pt) py (cadr pt) x1 (car v1) y1 (cadr v1) x2 (car v2) y2 (cadr v2) ) ;; Let's ensure that (x1,y1) is "lower" than (x2,y2): (if (> y1 y2) (progn (setq x1 (car v2) y1 (cadr v2) x2 (car v1) y2 (cadr v1) ) ) ) ;; Intersection condition: (and ;; 1) py is strictly above the lower vertex and not higher than the upper one (> py y1) (<= py y2) ;; 2) px < abscissas of the intersection point of the ray with the segment (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2 intersectX) (setq px (car pt) py (cadr pt) x1 (car v1) y1 (cadr v1) x2 (car v2) y2 (cadr v2) ) ) ;; Let's ensure that (x1,y1) is "lower" than (x2,y2) (if (> y1 y2) (setq x1 (car v2) y1 (cadr v2) x2 (car v1) y2 (cadr v1) ) ) ) ;; Counting the intersection coordinate (setq intersectX (if (/= y2 y1) (+ x1 (* (- py y1) (/ (- x2 x1) (- y2 y1)))) x1 ;; if the segment is horizontal, it is usually skipped. ) ) ;; We are returning (and ...), or nil (and (> py y1) ;; a point above the lower vertex (<= py y2) ;; and no higher than the top (> intersectX px) ) ) ;;----------------------------------------------- ;; the main part ;;----------------------------------------------- (setq ent (car (entsel "\nChoose a closed linear polyline: "))) (if (null ent) (progn (prompt "\nThe polyline is not selected. Completion.") (princ) ) (progn ;; 1) Step Request (setq step (getreal "\nEnter the step between the centers (??): ") ) (if (or (null step) (<= step 0.0)) (setq step 50.0) ;; the "backup" option ) ;; 2) Fixed radius (setq radius 2.0) ;; 3) List of vertices (minimum 3, otherwise not a polygon) (setq vlist (getPolyVertices ent)) (if (< (length vlist) 3) (progn (prompt "\nThe polyline has <3 vertices, and the contour is incorrect." ) (princ) ) (progn ;; 4) Defining bounding box (setq minx (apply 'min (mapcar 'car vlist)) maxx (apply 'max (mapcar 'car vlist)) miny (apply 'min (mapcar 'cadr vlist)) maxy (apply 'max (mapcar 'cadr vlist)) ) (prompt (strcat "\nboundary (bounding box) polyline:\n" " X: " (rtos minx 2 2) " ... " (rtos maxx 2 2) "\n Y: " (rtos miny 2 2) " ... " (rtos maxy 2 2) ) ) ;; 5) Building a grid "in a staggered manner" (setq row 0 y miny circulos 0 ) (setq osmant (getvar "osmode")) (setvar "osmode" 0) (while (<= y maxy) ;; For an odd row row, we shift X by step/2 (if (oddp row) (setq x (+ minx (/ step 2.0))) (setq x minx) ) (while (<= x maxx) (setq pt (list x y)) ;; If the center is inside the polyline, draw a circle. (if (comprobar_centralidad pt vlist) ;(pointInPolygon pt vlist) (progn ;;; (command "_.CIRCLE" pt radius) (creaCIRCULO pt radius) (setq circulos (+ circulos 1)) ) ) (setq x (+ x step)) ) (setq y (+ y step)) (setq row (1+ row)) ) (vla-regen (vla-get-activedocument (vlax-get-acad-object)) 0) (if (setq conj (ssget "_wp" vlist '((0 . "CIRCLE")))) (progn (princ (strcat "\nTotal number of cicles drawn: " (itoa circulos))) (setq circulos (sslength conj)) ) ) (if (setq ptx (getpoint "\nPick insertion point for circle number text (right click or ENTER for skip)...")) (vla-AddText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (itoa circulos) (VLAX-3D-POINT ptx) radius) ) (setvar "osmode" osmant) ) ) ) ) (princ) ) (defun c:WP-count (/ pl lstent points conj ptx creaMTEXT altura) (defun creaMTEXT (texto altura / vlaEnt) (setq vlaEnt (vla-AddMText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point ptx) 50 (strcat "Count:\\P" (itoa (sslength conj))))) (vlax-put-property vlaEnt "Height" altura) ) (if (setq pl (car (entsel "\nSelect border polyline..."))) (if (= "LWPOLYLINE" (cdr (assoc 0 (setq lstent (entget pl))))) (setq points (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) lstent ) ) ) ) ) (if points (progn (if (not altura1) (setq altura (getreal "\nHeight TEXT: ")) (setq altura (getreal (strcat "\nHeight TEXT (or ENTER for <" (rtos altura1 2 2) ">): "))) ) (if (not altura) (if altura1 (setq altura altura1) ) (setq altura1 altura) ) ) ) (if (and points altura (setq conj (ssget "_cp" points '((0 . "CIRCLE"))))) (if (setq ptx (getpoint (strcat "\nPick insertion point for objects number text <" (itoa (sslength conj)) "> (right click or ENTER for skip)..."))) (vla-AddText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (itoa (sslength conj)) (VLAX-3D-POINT ptx) altura) ) ) (princ) )
    1 point
  17. As for what you say about AutoCAD 2015, it seems strange to me. Although I have heard somewhere that this version of AutoCAD does strange things.
    1 point
  18. I don't understand why you changed the selection mode. The mode should be '_cp', not '_wp' In the last code I attached it is as it should be. Don't touch it
    1 point
  19. In the last code I have attached last time are the 2 updated commands. Copy them again and test them to make sure what you tell me. In 'WP-count' the selection mode is updated and works correctly. If you want to customize the text content you will have to modify the parameter '(itoa (sslenght conj))' of the function '(vla-AddText...) ' As for the pattern, so that the distribution of the circles is square and not rhomboidal, simply divide by 2 the parameter 'step' when the 'y' of the loop '(while (<= y maxy) ' is increased. '(setq y (+ y (/ step 2.0)))'
    1 point
  20. The way I make custom dcl's is that I use say Multi getvals to make a dcl file, I change the code. (setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w")) (setq fo (open (setq fname "D"\\acadtemp\\dcltest.dcl") "w")) Then I can see the dcl code I would then add a new row which would be Radio buttons for the "Hor" or "Ver" as choices. Lastly I use a lisp by rlx to convert the dcl code to lisp code and add to the program. Ok an easy answer here is Multi radio buttons.lsp look at the top of code and you will see a Yes or No option change to say HOR & VER. This will return the string "HOR" or "VER" so use with the IF. Multi radio buttons.lsp
    1 point
  21. That's it. Now it works. The code should work in AutoCAD 2015. I've tested it and it works. ACD2015.mp4
    1 point
  22. (defun c:Circles_Chess_outl (/ oddp ent step radius vlist minx miny maxx maxy x y row pt osmant circulos creaMTEXT ) ;;----------------------------------------------- ;; THE FUNCTION OF CHECKING WHETHER THE NUMBER IS ODD ;;----------------------------------------------- (defun oddp (n) (= (logand (fix n) 1) 1) ) ;;----------------------------------------------- ;; Local auxiliary functions ;;----------------------------------------------- ;; Extracting a list of vertices (points) of a linear 2D polyline: (defun getPolyVertices (e / ed lst pts) (setq ed (entget e) ;; selecting all groups of the DXF = 10 code (coordinates of the vertices) lst (vl-remove-if-not '(lambda (x) (= (car x) 10)) ed ) ;; turning them into a regular list of points (x y) pts (mapcar 'cdr lst) ) (if (= (vlax-get-property (vlax-ename->vla-object e) "Closed") ':vlax-true) (append pts (list (car pts))) pts ) ) ;; Checking whether the pt point is located inside the linear polygon v list: ;;; (defun pointInPolygon (pt vlist / cnt i v1 v2) ;;; (setq cnt 0 ;;; i 0 ;;; ) ;;; ;; "Let's "block" the list so that we can bypass the pair (list[i], list[i+1]): ;;; (setq vlist (append vlist (list (car vlist)))) ;;; (repeat (1- (length vlist)) ;;; (setq v1 (nth i vlist) ;;; v2 (nth (1+ i) vlist) ;;; i (1+ i) ;;; ) ;;; (if (edgeIntersectsRay pt v1 v2) ;;; (setq cnt (1+ cnt)) ;;; ) ;;; ) ;;; ;; If the number of intersections with the ray is odd, the point inside ;;; (if (= (logand cnt 1) 1) ;;; T ;;; nil ;;; ) ;;; ) (defun comprobar_centralidad (pto lst_ptos_rto / pt_inters+ pt_inters- n pt1 pt2 inters_negat inters_posit ) (setq n 0) (repeat (- (length lst_ptos_rto) 1) (setq pt_inters+ (inters pto (list (+ (car pto) 100000) (cadr pto)) (setq pt1 (nth n lst_ptos_rto)) (setq pt2 (nth (+ n 1) lst_ptos_rto)) ) ) (if (and pt_inters+ (not (member (cons 10 pt_inters+) lst_ptos_rto)) ) (if inters_posit (setq inters_posit (+ inters_posit 1)) (setq inters_posit 1) ) ) (setq pt_inters- (inters pto (list (- (car pto) 100000) (cadr pto)) pt1 pt2 ) ) (if (and pt_inters- (not (member (cons 10 pt_inters-) lst_ptos_rto)) ) (if inters_negat (setq inters_negat (+ inters_negat 1)) (setq inters_negat 1) ) ) (setq n (+ n 1)) ) (if (and (= (rem (if (not inters_negat) 0 inters_negat ) 2 ) 0 ) (= (rem (if (not inters_posit) 0 inters_posit ) 2 ) 0 ) ) nil T ) ) (defun creaMTEXT (texto altura / vlaEnt) (setq vlaEnt (vla-AddMText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point ptx) 50 texto)) (vlax-put-property vlaEnt "Height" altura) ) (defun creaCIRCULO (pto radio / vlaEnt) (setq vlaEnt (vla-AddCircle (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point pto) radio)) ) ;; Checking the intersection of the horizontal ray to the right of pt with the segment (v1,v2): (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2) (setq px (car pt) py (cadr pt) x1 (car v1) y1 (cadr v1) x2 (car v2) y2 (cadr v2) ) ;; Let's ensure that (x1,y1) is "lower" than (x2,y2): (if (> y1 y2) (progn (setq x1 (car v2) y1 (cadr v2) x2 (car v1) y2 (cadr v1) ) ) ) ;; Intersection condition: (and ;; 1) py is strictly above the lower vertex and not higher than the upper one (> py y1) (<= py y2) ;; 2) px < abscissas of the intersection point of the ray with the segment (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2 intersectX) (setq px (car pt) py (cadr pt) x1 (car v1) y1 (cadr v1) x2 (car v2) y2 (cadr v2) ) ) ;; Let's ensure that (x1,y1) is "lower" than (x2,y2) (if (> y1 y2) (setq x1 (car v2) y1 (cadr v2) x2 (car v1) y2 (cadr v1) ) ) ) ;; Counting the intersection coordinate (setq intersectX (if (/= y2 y1) (+ x1 (* (- py y1) (/ (- x2 x1) (- y2 y1)))) x1 ;; if the segment is horizontal, it is usually skipped. ) ) ;; We are returning (and ...), or nil (and (> py y1) ;; a point above the lower vertex (<= py y2) ;; and no higher than the top (> intersectX px) ) ) ;;----------------------------------------------- ;; the main part ;;----------------------------------------------- (setq ent (car (entsel "\nChoose a closed linear polyline: "))) (if (null ent) (progn (prompt "\nThe polyline is not selected. Completion.") (princ) ) (progn ;; 1) Step Request (setq step (getreal "\nEnter the step between the centers (??): ") ) (if (or (null step) (<= step 0.0)) (setq step 50.0) ;; the "backup" option ) ;; 2) Fixed radius (setq radius 25.0) ;; 3) List of vertices (minimum 3, otherwise not a polygon) (setq vlist (getPolyVertices ent)) (if (< (length vlist) 3) (progn (prompt "\nThe polyline has <3 vertices, and the contour is incorrect." ) (princ) ) (progn ;; 4) Defining bounding box (setq minx (apply 'min (mapcar 'car vlist)) maxx (apply 'max (mapcar 'car vlist)) miny (apply 'min (mapcar 'cadr vlist)) maxy (apply 'max (mapcar 'cadr vlist)) ) (prompt (strcat "\nboundary (bounding box) polyline:\n" " X: " (rtos minx 2 2) " ... " (rtos maxx 2 2) "\n Y: " (rtos miny 2 2) " ... " (rtos maxy 2 2) ) ) ;; 5) Building a grid "in a staggered manner" (setq row 0 y miny circulos 0 ) (setq osmant (getvar "osmode")) (setvar "osmode" 0) (while (<= y maxy) ;; For an odd row row, we shift X by step/2 (if (oddp row) (setq x (+ minx (/ step 2.0))) (setq x minx) ) (while (<= x maxx) (setq pt (list x y)) ;; If the center is inside the polyline, draw a circle. (if (comprobar_centralidad pt vlist) ;(pointInPolygon pt vlist) (progn ;;; (command "_.CIRCLE" pt radius) (creaCIRCULO pt radius) (setq circulos (+ circulos 1)) ) ) (setq x (+ x step)) ) (setq y (+ y step)) (setq row (1+ row)) ) (if (setq ptx (getpoint "\nPick insertion point for circle number text (right click or ENTER for skip)...")) (vla-AddText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (itoa circulos) (VLAX-3D-POINT ptx) radius) ;;; (vla-AddText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (strcat "Number of circles drawn: " (itoa circulos)) (VLAX-3D-POINT ptx) (/ radius 2.0)) ;;; (creaMTEXT (strcat "Count:\\P" (itoa circulos)) (/ radius 2.0)) ) (setvar "osmode" osmant) ) ) ) ) (princ) ) (defun c:WP-count (/ pl lstent points conj ptx creaMTEXT altura) (defun creaMTEXT (texto altura / vlaEnt) (setq vlaEnt (vla-AddMText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point ptx) 50 (strcat "Count:\\P" (itoa (sslength conj))))) (vlax-put-property vlaEnt "Height" altura) ) (if (setq pl (car (entsel "\nSelect border polyline..."))) (if (= "LWPOLYLINE" (cdr (assoc 0 (setq lstent (entget pl))))) (setq points (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) lstent ) ) ) ) ) (if points (progn (if (not altura1) (setq altura (getreal "\nHeight TEXT: ")) (setq altura (getreal (strcat "\nHeight TEXT (or ENTER for <" (rtos altura1 2 2) ">): "))) ) (if (not altura) (if altura1 (setq altura altura1) ) (setq altura1 altura) ) ) ) (if (and points altura (setq conj (ssget "_cp" points '((0 . "CIRCLE"))))) (if (setq ptx (getpoint (strcat "\nPick insertion point for objects number text <" (itoa (sslength conj)) "> (right click or ENTER for skip)..."))) (vla-AddText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (itoa (sslength conj)) (VLAX-3D-POINT ptx) altura) ) ) (princ) )
    1 point
  23. The problem is in the 'getPolyVertices' function. When it comes to a closed polyline, it does not add the final closing point. For this reason, 'comprobar_centralidad' does not work correctly. Adjust the function as I show you in the image
    1 point
  24. One last thing: Steven is right. It's better not to use 'command'. The code runs slower and is vulnerable to the state of the "osmode" system variable. That's why I've updated your code so that the circles are generated faster. (defun c:Circles_Chess_outl (/ oddp ent step radius vlist minx miny maxx maxy x y row pt osmant circulos creaMTEXT ) ;;----------------------------------------------- ;; THE FUNCTION OF CHECKING WHETHER THE NUMBER IS ODD ;;----------------------------------------------- (defun oddp (n) (= (logand (fix n) 1) 1) ) ;;----------------------------------------------- ;; Local auxiliary functions ;;----------------------------------------------- ;; Extracting a list of vertices (points) of a linear 2D polyline: (defun getPolyVertices (e / ed lst pts) (setq ed (entget e) ;; selecting all groups of the DXF = 10 code (coordinates of the vertices) lst (vl-remove-if-not '(lambda (x) (= (car x) 10)) ed ) ;; turning them into a regular list of points (x y) pts (mapcar 'cdr lst) ) pts ) ;; Checking whether the pt point is located inside the linear polygon v list: ;;; (defun pointInPolygon (pt vlist / cnt i v1 v2) ;;; (setq cnt 0 ;;; i 0 ;;; ) ;;; ;; "Let's "block" the list so that we can bypass the pair (list[i], list[i+1]): ;;; (setq vlist (append vlist (list (car vlist)))) ;;; (repeat (1- (length vlist)) ;;; (setq v1 (nth i vlist) ;;; v2 (nth (1+ i) vlist) ;;; i (1+ i) ;;; ) ;;; (if (edgeIntersectsRay pt v1 v2) ;;; (setq cnt (1+ cnt)) ;;; ) ;;; ) ;;; ;; If the number of intersections with the ray is odd, the point inside ;;; (if (= (logand cnt 1) 1) ;;; T ;;; nil ;;; ) ;;; ) (defun comprobar_centralidad (pto lst_ptos_rto / pt_inters+ pt_inters- n pt1 pt2 inters_negat inters_posit ) (setq n 0) (repeat (- (length lst_ptos_rto) 1) (setq pt_inters+ (inters pto (list (+ (car pto) 100000) (cadr pto)) (setq pt1 (nth n lst_ptos_rto)) (setq pt2 (nth (+ n 1) lst_ptos_rto)) ) ) (if (and pt_inters+ (not (member (cons 10 pt_inters+) lst_ptos_rto)) ) (if inters_posit (setq inters_posit (+ inters_posit 1)) (setq inters_posit 1) ) ) (setq pt_inters- (inters pto (list (- (car pto) 100000) (cadr pto)) pt1 pt2 ) ) (if (and pt_inters- (not (member (cons 10 pt_inters-) lst_ptos_rto)) ) (if inters_negat (setq inters_negat (+ inters_negat 1)) (setq inters_negat 1) ) ) (setq n (+ n 1)) ) (if (and (= (rem (if (not inters_negat) 0 inters_negat ) 2 ) 0 ) (= (rem (if (not inters_posit) 0 inters_posit ) 2 ) 0 ) ) nil T ) ) (defun creaMTEXT (texto altura / vlaEnt) (setq vlaEnt (vla-AddMText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point ptx) 50 texto)) (vlax-put-property vlaEnt "Height" altura) ) (defun creaCIRCULO (pto radio / vlaEnt) (setq vlaEnt (vla-AddCircle (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point pto) radio)) ) ;; Checking the intersection of the horizontal ray to the right of pt with the segment (v1,v2): (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2) (setq px (car pt) py (cadr pt) x1 (car v1) y1 (cadr v1) x2 (car v2) y2 (cadr v2) ) ;; Let's ensure that (x1,y1) is "lower" than (x2,y2): (if (> y1 y2) (progn (setq x1 (car v2) y1 (cadr v2) x2 (car v1) y2 (cadr v1) ) ) ) ;; Intersection condition: (and ;; 1) py is strictly above the lower vertex and not higher than the upper one (> py y1) (<= py y2) ;; 2) px < abscissas of the intersection point of the ray with the segment (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2 intersectX) (setq px (car pt) py (cadr pt) x1 (car v1) y1 (cadr v1) x2 (car v2) y2 (cadr v2) ) ) ;; Let's ensure that (x1,y1) is "lower" than (x2,y2) (if (> y1 y2) (setq x1 (car v2) y1 (cadr v2) x2 (car v1) y2 (cadr v1) ) ) ) ;; Counting the intersection coordinate (setq intersectX (if (/= y2 y1) (+ x1 (* (- py y1) (/ (- x2 x1) (- y2 y1)))) x1 ;; if the segment is horizontal, it is usually skipped. ) ) ;; We are returning (and ...), or nil (and (> py y1) ;; a point above the lower vertex (<= py y2) ;; and no higher than the top (> intersectX px) ) ) ;;----------------------------------------------- ;; the main part ;;----------------------------------------------- (setq ent (car (entsel "\nChoose a closed linear polyline: "))) (if (null ent) (progn (prompt "\nThe polyline is not selected. Completion.") (princ) ) (progn ;; 1) Step Request (setq step (getreal "\nEnter the step between the centers (??): ") ) (if (or (null step) (<= step 0.0)) (setq step 50.0) ;; the "backup" option ) ;; 2) Fixed radius (setq radius 25.0) ;; 3) List of vertices (minimum 3, otherwise not a polygon) (setq vlist (getPolyVertices ent)) (if (< (length vlist) 3) (progn (prompt "\nThe polyline has <3 vertices, and the contour is incorrect." ) (princ) ) (progn ;; 4) Defining bounding box (setq minx (apply 'min (mapcar 'car vlist)) maxx (apply 'max (mapcar 'car vlist)) miny (apply 'min (mapcar 'cadr vlist)) maxy (apply 'max (mapcar 'cadr vlist)) ) (prompt (strcat "\nboundary (bounding box) polyline:\n" " X: " (rtos minx 2 2) " ... " (rtos maxx 2 2) "\n Y: " (rtos miny 2 2) " ... " (rtos maxy 2 2) ) ) ;; 5) Building a grid "in a staggered manner" (setq row 0 y miny circulos 0 ) (setq osmant (getvar "osmode")) (setvar "osmode" 0) (while (<= y maxy) ;; For an odd row row, we shift X by step/2 (if (oddp row) (setq x (+ minx (/ step 2.0))) (setq x minx) ) (while (<= x maxx) (setq pt (list x y)) ;; If the center is inside the polyline, draw a circle. (if (comprobar_centralidad pt vlist) ;(pointInPolygon pt vlist) (progn ;;; (command "_.CIRCLE" pt radius) (creaCIRCULO pt radius) (setq circulos (+ circulos 1)) ) ) (setq x (+ x step)) ) (setq y (+ y step)) (setq row (1+ row)) ) (if (setq ptx (getpoint "\nPick insertion point for circle number text (right click or ENTER for skip)...")) (vla-AddText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (itoa circulos) (VLAX-3D-POINT ptx) (/ radius 2.0)) ;;; (vla-AddText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (strcat "Number of circles drawn: " (itoa circulos)) (VLAX-3D-POINT ptx) (/ radius 2.0)) ;;; (creaMTEXT (strcat "Count:\\P" (itoa circulos)) (/ radius 2.0)) ) (setvar "osmode" osmant) ) ) ) ) (princ) )
    1 point
  25. Yes, everything is fine now! Thank you so much for your help! Dreams come true...
    1 point
  26. (defun c:Circles_Chess_outl (/ oddp ent step radius vlist minx miny maxx maxy x y row pt osmant circulos creaMTEXT ) ;;----------------------------------------------- ;; THE FUNCTION OF CHECKING WHETHER THE NUMBER IS ODD ;;----------------------------------------------- (defun oddp (n) (= (logand (fix n) 1) 1) ) ;;----------------------------------------------- ;; Local auxiliary functions ;;----------------------------------------------- ;; Extracting a list of vertices (points) of a linear 2D polyline: (defun getPolyVertices (e / ed lst pts) (setq ed (entget e) ;; selecting all groups of the DXF = 10 code (coordinates of the vertices) lst (vl-remove-if-not '(lambda (x) (= (car x) 10)) ed ) ;; turning them into a regular list of points (x y) pts (mapcar 'cdr lst) ) pts ) ;; Checking whether the pt point is located inside the linear polygon v list: ;;; (defun pointInPolygon (pt vlist / cnt i v1 v2) ;;; (setq cnt 0 ;;; i 0 ;;; ) ;;; ;; "Let's "block" the list so that we can bypass the pair (list[i], list[i+1]): ;;; (setq vlist (append vlist (list (car vlist)))) ;;; (repeat (1- (length vlist)) ;;; (setq v1 (nth i vlist) ;;; v2 (nth (1+ i) vlist) ;;; i (1+ i) ;;; ) ;;; (if (edgeIntersectsRay pt v1 v2) ;;; (setq cnt (1+ cnt)) ;;; ) ;;; ) ;;; ;; If the number of intersections with the ray is odd, the point inside ;;; (if (= (logand cnt 1) 1) ;;; T ;;; nil ;;; ) ;;; ) (defun comprobar_centralidad (pto lst_ptos_rto / pt_inters+ pt_inters- n pt1 pt2 inters_negat inters_posit ) (setq n 0) (repeat (- (length lst_ptos_rto) 1) (setq pt_inters+ (inters pto (list (+ (car pto) 100000) (cadr pto)) (setq pt1 (nth n lst_ptos_rto)) (setq pt2 (nth (+ n 1) lst_ptos_rto)) ) ) (if (and pt_inters+ (not (member (cons 10 pt_inters+) lst_ptos_rto)) ) (if inters_posit (setq inters_posit (+ inters_posit 1)) (setq inters_posit 1) ) ) (setq pt_inters- (inters pto (list (- (car pto) 100000) (cadr pto)) pt1 pt2 ) ) (if (and pt_inters- (not (member (cons 10 pt_inters-) lst_ptos_rto)) ) (if inters_negat (setq inters_negat (+ inters_negat 1)) (setq inters_negat 1) ) ) (setq n (+ n 1)) ) (if (and (= (rem (if (not inters_negat) 0 inters_negat ) 2 ) 0 ) (= (rem (if (not inters_posit) 0 inters_posit ) 2 ) 0 ) ) nil T ) ) (defun creaMTEXT (texto altura / vlaEnt) (setq vlaEnt (vla-AddMText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point ptx) 50 texto)) (vlax-put-property vlaEnt "Height" altura) ) ;; Checking the intersection of the horizontal ray to the right of pt with the segment (v1,v2): (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2) (setq px (car pt) py (cadr pt) x1 (car v1) y1 (cadr v1) x2 (car v2) y2 (cadr v2) ) ;; Let's ensure that (x1,y1) is "lower" than (x2,y2): (if (> y1 y2) (progn (setq x1 (car v2) y1 (cadr v2) x2 (car v1) y2 (cadr v1) ) ) ) ;; Intersection condition: (and ;; 1) py is strictly above the lower vertex and not higher than the upper one (> py y1) (<= py y2) ;; 2) px < abscissas of the intersection point of the ray with the segment (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2 intersectX) (setq px (car pt) py (cadr pt) x1 (car v1) y1 (cadr v1) x2 (car v2) y2 (cadr v2) ) ) ;; Let's ensure that (x1,y1) is "lower" than (x2,y2) (if (> y1 y2) (setq x1 (car v2) y1 (cadr v2) x2 (car v1) y2 (cadr v1) ) ) ) ;; Counting the intersection coordinate (setq intersectX (if (/= y2 y1) (+ x1 (* (- py y1) (/ (- x2 x1) (- y2 y1)))) x1 ;; if the segment is horizontal, it is usually skipped. ) ) ;; We are returning (and ...), or nil (and (> py y1) ;; a point above the lower vertex (<= py y2) ;; and no higher than the top (> intersectX px) ) ) ;;----------------------------------------------- ;; the main part ;;----------------------------------------------- (setq ent (car (entsel "\nChoose a closed linear polyline: "))) (if (null ent) (progn (prompt "\nThe polyline is not selected. Completion.") (princ) ) (progn ;; 1) Step Request (setq step (getreal "\nEnter the step between the centers (??): ") ) (if (or (null step) (<= step 0.0)) (setq step 50.0) ;; the "backup" option ) ;; 2) Fixed radius (setq radius 25.0) ;; 3) List of vertices (minimum 3, otherwise not a polygon) (setq vlist (getPolyVertices ent)) (if (< (length vlist) 3) (progn (prompt "\nThe polyline has <3 vertices, and the contour is incorrect." ) (princ) ) (progn ;; 4) Defining bounding box (setq minx (apply 'min (mapcar 'car vlist)) maxx (apply 'max (mapcar 'car vlist)) miny (apply 'min (mapcar 'cadr vlist)) maxy (apply 'max (mapcar 'cadr vlist)) ) (prompt (strcat "\nboundary (bounding box) polyline:\n" " X: " (rtos minx 2 2) " ... " (rtos maxx 2 2) "\n Y: " (rtos miny 2 2) " ... " (rtos maxy 2 2) ) ) ;; 5) Building a grid "in a staggered manner" (setq row 0 y miny circulos 0 ) (setq osmant (getvar "osmode")) (setvar "osmode" 0) (while (<= y maxy) ;; For an odd row row, we shift X by step/2 (if (oddp row) (setq x (+ minx (/ step 2.0))) (setq x minx) ) (while (<= x maxx) (setq pt (list x y)) ;; If the center is inside the polyline, draw a circle. (if (comprobar_centralidad pt vlist) ;(pointInPolygon pt vlist) (progn (command "_.CIRCLE" pt radius) (setq circulos (+ circulos 1)) ) ) (setq x (+ x step)) ) (setq y (+ y step)) (setq row (1+ row)) ) (if (setq ptx (getpoint "\nPick insertion point for circle number text (right click or ENTER for skip)...")) (vla-AddText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (itoa circulos) (VLAX-3D-POINT ptx) (/ radius 2.0)) ;;; (vla-AddText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (strcat "Number of circles drawn: " (itoa circulos)) (VLAX-3D-POINT ptx) (/ radius 2.0)) ;;; (creaMTEXT (strcat "Count:\\P" (itoa circulos)) (/ radius 2.0)) ) (setvar "osmode" osmant) ) ) ) ) (princ) )
    1 point
  27. Wait I just noticed that for some reason the website didn't update my edited code. I'll attach it again
    1 point
  28. Please copy the code again It should write only the number in a single line text
    1 point
  29. For the text content and its size you will have to edit the code yourself
    1 point
  30. There is also another detail: in the command 'c:WP-count' you must change the selection mode from ' ssget "_wp" ' to ' ssget "_cp" ' so that it selects not only the objects that are fully included
    1 point
  31. I've edited the last code. Now it will work
    1 point
  32. Im sorry I forgot to change something in the main command I attach the correction below (defun c:Circles_Chess_outl (/ oddp ent step radius vlist minx miny maxx maxy x y row pt osmant circulos creaMTEXT ) ;;----------------------------------------------- ;; THE FUNCTION OF CHECKING WHETHER THE NUMBER IS ODD ;;----------------------------------------------- (defun oddp (n) (= (logand (fix n) 1) 1) ) ;;----------------------------------------------- ;; Local auxiliary functions ;;----------------------------------------------- ;; Extracting a list of vertices (points) of a linear 2D polyline: (defun getPolyVertices (e / ed lst pts) (setq ed (entget e) ;; selecting all groups of the DXF = 10 code (coordinates of the vertices) lst (vl-remove-if-not '(lambda (x) (= (car x) 10)) ed ) ;; turning them into a regular list of points (x y) pts (mapcar 'cdr lst) ) pts ) ;; Checking whether the pt point is located inside the linear polygon v list: ;;; (defun pointInPolygon (pt vlist / cnt i v1 v2) ;;; (setq cnt 0 ;;; i 0 ;;; ) ;;; ;; "Let's "block" the list so that we can bypass the pair (list[i], list[i+1]): ;;; (setq vlist (append vlist (list (car vlist)))) ;;; (repeat (1- (length vlist)) ;;; (setq v1 (nth i vlist) ;;; v2 (nth (1+ i) vlist) ;;; i (1+ i) ;;; ) ;;; (if (edgeIntersectsRay pt v1 v2) ;;; (setq cnt (1+ cnt)) ;;; ) ;;; ) ;;; ;; If the number of intersections with the ray is odd, the point inside ;;; (if (= (logand cnt 1) 1) ;;; T ;;; nil ;;; ) ;;; ) (defun comprobar_centralidad (pto lst_ptos_rto / pt_inters+ pt_inters- n pt1 pt2 inters_negat inters_posit ) (setq n 0) (repeat (- (length lst_ptos_rto) 1) (setq pt_inters+ (inters pto (list (+ (car pto) 100000) (cadr pto)) (setq pt1 (nth n lst_ptos_rto)) (setq pt2 (nth (+ n 1) lst_ptos_rto)) ) ) (if (and pt_inters+ (not (member (cons 10 pt_inters+) lst_ptos_rto)) ) (if inters_posit (setq inters_posit (+ inters_posit 1)) (setq inters_posit 1) ) ) (setq pt_inters- (inters pto (list (- (car pto) 100000) (cadr pto)) pt1 pt2 ) ) (if (and pt_inters- (not (member (cons 10 pt_inters-) lst_ptos_rto)) ) (if inters_negat (setq inters_negat (+ inters_negat 1)) (setq inters_negat 1) ) ) (setq n (+ n 1)) ) (if (and (= (rem (if (not inters_negat) 0 inters_negat ) 2 ) 0 ) (= (rem (if (not inters_posit) 0 inters_posit ) 2 ) 0 ) ) nil T ) ) (defun creaMTEXT (texto altura / vlaEnt) (setq vlaEnt (vla-AddMText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point ptx) 50 (strcat "Count:\\P" texto))) (vlax-put-property vlaEnt "Height" altura) ) ;; Checking the intersection of the horizontal ray to the right of pt with the segment (v1,v2): (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2) (setq px (car pt) py (cadr pt) x1 (car v1) y1 (cadr v1) x2 (car v2) y2 (cadr v2) ) ;; Let's ensure that (x1,y1) is "lower" than (x2,y2): (if (> y1 y2) (progn (setq x1 (car v2) y1 (cadr v2) x2 (car v1) y2 (cadr v1) ) ) ) ;; Intersection condition: (and ;; 1) py is strictly above the lower vertex and not higher than the upper one (> py y1) (<= py y2) ;; 2) px < abscissas of the intersection point of the ray with the segment (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2 intersectX) (setq px (car pt) py (cadr pt) x1 (car v1) y1 (cadr v1) x2 (car v2) y2 (cadr v2) ) ) ;; Let's ensure that (x1,y1) is "lower" than (x2,y2) (if (> y1 y2) (setq x1 (car v2) y1 (cadr v2) x2 (car v1) y2 (cadr v1) ) ) ) ;; Counting the intersection coordinate (setq intersectX (if (/= y2 y1) (+ x1 (* (- py y1) (/ (- x2 x1) (- y2 y1)))) x1 ;; if the segment is horizontal, it is usually skipped. ) ) ;; We are returning (and ...), or nil (and (> py y1) ;; a point above the lower vertex (<= py y2) ;; and no higher than the top (> intersectX px) ) ) ;;----------------------------------------------- ;; the main part ;;----------------------------------------------- (setq ent (car (entsel "\nChoose a closed linear polyline: "))) (if (null ent) (progn (prompt "\nThe polyline is not selected. Completion.") (princ) ) (progn ;; 1) Step Request (setq step (getreal "\nEnter the step between the centers (??): ") ) (if (or (null step) (<= step 0.0)) (setq step 50.0) ;; the "backup" option ) ;; 2) Fixed radius (setq radius 25.0) ;; 3) List of vertices (minimum 3, otherwise not a polygon) (setq vlist (getPolyVertices ent)) (if (< (length vlist) 3) (progn (prompt "\nThe polyline has <3 vertices, and the contour is incorrect." ) (princ) ) (progn ;; 4) Defining bounding box (setq minx (apply 'min (mapcar 'car vlist)) maxx (apply 'max (mapcar 'car vlist)) miny (apply 'min (mapcar 'cadr vlist)) maxy (apply 'max (mapcar 'cadr vlist)) ) (prompt (strcat "\nboundary (bounding box) polyline:\n" " X: " (rtos minx 2 2) " ... " (rtos maxx 2 2) "\n Y: " (rtos miny 2 2) " ... " (rtos maxy 2 2) ) ) ;; 5) Building a grid "in a staggered manner" (setq row 0 y miny circulos 0 ) (setq osmant (getvar "osmode")) (setvar "osmode" 0) (while (<= y maxy) ;; For an odd row row, we shift X by step/2 (if (oddp row) (setq x (+ minx (/ step 2.0))) (setq x minx) ) (while (<= x maxx) (setq pt (list x y)) ;; If the center is inside the polyline, draw a circle. (if (comprobar_centralidad pt vlist) ;(pointInPolygon pt vlist) (progn (command "_.CIRCLE" pt radius) (setq circulos (+ circulos 1)) ) ) (setq x (+ x step)) ) (setq y (+ y step)) (setq row (1+ row)) ) (if (setq ptx (getpoint "\nPick insertion point for circle number text (right click or ENTER for skip)...")) ;;; (vla-AddText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (strcat "Number of circles drawn: " (itoa circulos)) (VLAX-3D-POINT ptx) (/ radius 2.0)) (creaMTEXT (strcat "Count:\\P" (itoa circulos)) (/ radius 2.0)) ) (setvar "osmode" osmant) ) ) ) ) (princ) )
    1 point
  33. In the main function I have predefined the height of the MTEXT to half the radius of the circles. If you want to modify it you will have to go into the code and change it. I have also written a separate command. I hope it helps.
    1 point
  34. (defun c:Circles_Chess_outl (/ oddp ent step radius vlist minx miny maxx maxy x y row pt osmant circulos creaMTEXT ) ;;----------------------------------------------- ;; THE FUNCTION OF CHECKING WHETHER THE NUMBER IS ODD ;;----------------------------------------------- (defun oddp (n) (= (logand (fix n) 1) 1) ) ;;----------------------------------------------- ;; Local auxiliary functions ;;----------------------------------------------- ;; Extracting a list of vertices (points) of a linear 2D polyline: (defun getPolyVertices (e / ed lst pts) (setq ed (entget e) ;; selecting all groups of the DXF = 10 code (coordinates of the vertices) lst (vl-remove-if-not '(lambda (x) (= (car x) 10)) ed ) ;; turning them into a regular list of points (x y) pts (mapcar 'cdr lst) ) pts ) ;; Checking whether the pt point is located inside the linear polygon v list: ;;; (defun pointInPolygon (pt vlist / cnt i v1 v2) ;;; (setq cnt 0 ;;; i 0 ;;; ) ;;; ;; "Let's "block" the list so that we can bypass the pair (list[i], list[i+1]): ;;; (setq vlist (append vlist (list (car vlist)))) ;;; (repeat (1- (length vlist)) ;;; (setq v1 (nth i vlist) ;;; v2 (nth (1+ i) vlist) ;;; i (1+ i) ;;; ) ;;; (if (edgeIntersectsRay pt v1 v2) ;;; (setq cnt (1+ cnt)) ;;; ) ;;; ) ;;; ;; If the number of intersections with the ray is odd, the point inside ;;; (if (= (logand cnt 1) 1) ;;; T ;;; nil ;;; ) ;;; ) (defun comprobar_centralidad (pto lst_ptos_rto / pt_inters+ pt_inters- n pt1 pt2 inters_negat inters_posit ) (setq n 0) (repeat (- (length lst_ptos_rto) 1) (setq pt_inters+ (inters pto (list (+ (car pto) 100000) (cadr pto)) (setq pt1 (nth n lst_ptos_rto)) (setq pt2 (nth (+ n 1) lst_ptos_rto)) ) ) (if (and pt_inters+ (not (member (cons 10 pt_inters+) lst_ptos_rto)) ) (if inters_posit (setq inters_posit (+ inters_posit 1)) (setq inters_posit 1) ) ) (setq pt_inters- (inters pto (list (- (car pto) 100000) (cadr pto)) pt1 pt2 ) ) (if (and pt_inters- (not (member (cons 10 pt_inters-) lst_ptos_rto)) ) (if inters_negat (setq inters_negat (+ inters_negat 1)) (setq inters_negat 1) ) ) (setq n (+ n 1)) ) (if (and (= (rem (if (not inters_negat) 0 inters_negat ) 2 ) 0 ) (= (rem (if (not inters_posit) 0 inters_posit ) 2 ) 0 ) ) nil T ) ) (defun creaMTEXT (texto altura / vlaEnt) (setq vlaEnt (vla-AddMText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point ptx) 50 (strcat "Count:\\P" (itoa (sslength conj))))) (vlax-put-property vlaEnt "Height" altura) ) ;; Checking the intersection of the horizontal ray to the right of pt with the segment (v1,v2): (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2) (setq px (car pt) py (cadr pt) x1 (car v1) y1 (cadr v1) x2 (car v2) y2 (cadr v2) ) ;; Let's ensure that (x1,y1) is "lower" than (x2,y2): (if (> y1 y2) (progn (setq x1 (car v2) y1 (cadr v2) x2 (car v1) y2 (cadr v1) ) ) ) ;; Intersection condition: (and ;; 1) py is strictly above the lower vertex and not higher than the upper one (> py y1) (<= py y2) ;; 2) px < abscissas of the intersection point of the ray with the segment (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2 intersectX) (setq px (car pt) py (cadr pt) x1 (car v1) y1 (cadr v1) x2 (car v2) y2 (cadr v2) ) ) ;; Let's ensure that (x1,y1) is "lower" than (x2,y2) (if (> y1 y2) (setq x1 (car v2) y1 (cadr v2) x2 (car v1) y2 (cadr v1) ) ) ) ;; Counting the intersection coordinate (setq intersectX (if (/= y2 y1) (+ x1 (* (- py y1) (/ (- x2 x1) (- y2 y1)))) x1 ;; if the segment is horizontal, it is usually skipped. ) ) ;; We are returning (and ...), or nil (and (> py y1) ;; a point above the lower vertex (<= py y2) ;; and no higher than the top (> intersectX px) ) ) ;;----------------------------------------------- ;; the main part ;;----------------------------------------------- (setq ent (car (entsel "\nChoose a closed linear polyline: "))) (if (null ent) (progn (prompt "\nThe polyline is not selected. Completion.") (princ) ) (progn ;; 1) Step Request (setq step (getreal "\nEnter the step between the centers (??): ") ) (if (or (null step) (<= step 0.0)) (setq step 50.0) ;; the "backup" option ) ;; 2) Fixed radius (setq radius 25.0) ;; 3) List of vertices (minimum 3, otherwise not a polygon) (setq vlist (getPolyVertices ent)) (if (< (length vlist) 3) (progn (prompt "\nThe polyline has <3 vertices, and the contour is incorrect." ) (princ) ) (progn ;; 4) Defining bounding box (setq minx (apply 'min (mapcar 'car vlist)) maxx (apply 'max (mapcar 'car vlist)) miny (apply 'min (mapcar 'cadr vlist)) maxy (apply 'max (mapcar 'cadr vlist)) ) (prompt (strcat "\nboundary (bounding box) polyline:\n" " X: " (rtos minx 2 2) " ... " (rtos maxx 2 2) "\n Y: " (rtos miny 2 2) " ... " (rtos maxy 2 2) ) ) ;; 5) Building a grid "in a staggered manner" (setq row 0 y miny circulos 0 ) (setq osmant (getvar "osmode")) (setvar "osmode" 0) (while (<= y maxy) ;; For an odd row row, we shift X by step/2 (if (oddp row) (setq x (+ minx (/ step 2.0))) (setq x minx) ) (while (<= x maxx) (setq pt (list x y)) ;; If the center is inside the polyline, draw a circle. (if (comprobar_centralidad pt vlist) ;(pointInPolygon pt vlist) (progn (command "_.CIRCLE" pt radius) (setq circulos (+ circulos 1)) ) ) (setq x (+ x step)) ) (setq y (+ y step)) (setq row (1+ row)) ) (if (setq ptx (getpoint "\nPick insertion point for circle number text (right click or ENTER for skip)...")) ;;; (vla-AddText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (strcat "Number of circles drawn: " (itoa circulos)) (VLAX-3D-POINT ptx) (/ radius 2.0)) (creaMTEXT (strcat "Count:\\P" (itoa (sslength conj))) (/ radius 2.0)) ) (setvar "osmode" osmant) ) ) ) ) (princ) ) (defun c:WP-count (/ pl lstent points conj ptx creaMTEXT altura) (defun creaMTEXT (texto altura / vlaEnt) (setq vlaEnt (vla-AddMText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point ptx) 50 (strcat "Count:\\P" (itoa (sslength conj))))) (vlax-put-property vlaEnt "Height" altura) ) (if (setq pl (car (entsel "\nSelect border polyline..."))) (if (= "LWPOLYLINE" (cdr (assoc 0 (setq lstent (entget pl))))) (setq points (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) lstent ) ) ) ) ) (if points (progn (if (not altura1) (setq altura (getreal "\nHeight MTEXT: ")) (setq altura (getreal (strcat "\nHeight MTEXT (or ENTER for <" (rtos altura1 2 2) ">): "))) ) (if (not altura) (if altura1 (setq altura altura1) ) (setq altura1 altura) ) ) ) (if (and points altura (setq conj (ssget "_wp" points '((0 . "CIRCLE"))))) (if (setq ptx (getpoint (strcat "\nPick insertion point for objects number text <" (itoa (sslength conj)) "> (right click or ENTER for skip)..."))) ;;; (vla-AddText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (strcat "Count: " (itoa (sslength conj))) (VLAX-3D-POINT ptx) (/ radius 2.0)) (creaMTEXT (strcat "Count:\\P" (itoa (sslength conj))) altura) ) ) (princ) )
    1 point
  35. Such is the problem with cracked programs, they are not worth the price you paid.
    1 point
  36. Can you post what you have so far? There is also Taper Faces and Rotate Faces that come in handy. What type of 3D design are you doing? Cad64 is experienced in a good deal of 3D applications and has a very good YouTube page. I learned most of my techniques for 3D by trial and error and watching videos and reading tutorials once the internet was useful in those endeavors to refine and speed up my methods..
    1 point
  37. for creating entities if snapping is going to be a problem I'd use entmake or entmakex to draw what you need - especially a simple one like a circle. Saves worrying about setting system variables and resetting them after. For a count set a variable earlier in the code, say (setq acounter 0). For counting add a (setq acounter (+ acounter 1)) just after you draw the circle (you'll need to add a (progn for the 'if' too)... an easy count of how many circles were drawn
    1 point
  38. Like that (defun c:Circles_Chess_outl (/ oddp ent step radius vlist minx miny maxx maxy x y row pt osmant ) ;;----------------------------------------------- ;; THE FUNCTION OF CHECKING WHETHER THE NUMBER IS ODD ;;----------------------------------------------- (defun oddp (n) (= (logand (fix n) 1) 1) ) ;;----------------------------------------------- ;; Local auxiliary functions ;;----------------------------------------------- ;; Extracting a list of vertices (points) of a linear 2D polyline: (defun getPolyVertices (e / ed lst pts) (setq ed (entget e) ;; selecting all groups of the DXF = 10 code (coordinates of the vertices) lst (vl-remove-if-not '(lambda (x) (= (car x) 10)) ed ) ;; turning them into a regular list of points (x y) pts (mapcar 'cdr lst) ) pts ) ;; Checking whether the pt point is located inside the linear polygon v list: ;;; (defun pointInPolygon (pt vlist / cnt i v1 v2) ;;; (setq cnt 0 ;;; i 0 ;;; ) ;;; ;; "Let's "block" the list so that we can bypass the pair (list[i], list[i+1]): ;;; (setq vlist (append vlist (list (car vlist)))) ;;; (repeat (1- (length vlist)) ;;; (setq v1 (nth i vlist) ;;; v2 (nth (1+ i) vlist) ;;; i (1+ i) ;;; ) ;;; (if (edgeIntersectsRay pt v1 v2) ;;; (setq cnt (1+ cnt)) ;;; ) ;;; ) ;;; ;; If the number of intersections with the ray is odd, the point inside ;;; (if (= (logand cnt 1) 1) ;;; T ;;; nil ;;; ) ;;; ) (defun comprobar_centralidad (pto lst_ptos_rto / pt_inters+ pt_inters- n pt1 pt2 inters_negat inters_posit ) (setq n 0) (repeat (- (length lst_ptos_rto) 1) (setq pt_inters+ (inters pto (list (+ (car pto) 100000) (cadr pto)) (setq pt1 (nth n lst_ptos_rto)) (setq pt2 (nth (+ n 1) lst_ptos_rto)) ) ) (if (and pt_inters+ (not (member (cons 10 pt_inters+) lst_ptos_rto)) ) (if inters_posit (setq inters_posit (+ inters_posit 1)) (setq inters_posit 1) ) ) (setq pt_inters- (inters pto (list (- (car pto) 100000) (cadr pto)) pt1 pt2 ) ) (if (and pt_inters- (not (member (cons 10 pt_inters-) lst_ptos_rto)) ) (if inters_negat (setq inters_negat (+ inters_negat 1)) (setq inters_negat 1) ) ) (setq n (+ n 1)) ) (if (and (= (rem (if (not inters_negat) 0 inters_negat ) 2 ) 0 ) (= (rem (if (not inters_posit) 0 inters_posit ) 2 ) 0 ) ) nil T ) ) ;; Checking the intersection of the horizontal ray to the right of pt with the segment (v1,v2): (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2) (setq px (car pt) py (cadr pt) x1 (car v1) y1 (cadr v1) x2 (car v2) y2 (cadr v2) ) ;; Let's ensure that (x1,y1) is "lower" than (x2,y2): (if (> y1 y2) (progn (setq x1 (car v2) y1 (cadr v2) x2 (car v1) y2 (cadr v1) ) ) ) ;; Intersection condition: (and ;; 1) py is strictly above the lower vertex and not higher than the upper one (> py y1) (<= py y2) ;; 2) px < abscissas of the intersection point of the ray with the segment (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2 intersectX) (setq px (car pt) py (cadr pt) x1 (car v1) y1 (cadr v1) x2 (car v2) y2 (cadr v2) ) ) ;; Let's ensure that (x1,y1) is "lower" than (x2,y2) (if (> y1 y2) (setq x1 (car v2) y1 (cadr v2) x2 (car v1) y2 (cadr v1) ) ) ) ;; Counting the intersection coordinate (setq intersectX (if (/= y2 y1) (+ x1 (* (- py y1) (/ (- x2 x1) (- y2 y1)))) x1 ;; if the segment is horizontal, it is usually skipped. ) ) ;; We are returning (and ...), or nil (and (> py y1) ;; a point above the lower vertex (<= py y2) ;; and no higher than the top (> intersectX px) ) ) ;;----------------------------------------------- ;; the main part ;;----------------------------------------------- (setq ent (car (entsel "\nChoose a closed linear polyline: "))) (if (null ent) (progn (prompt "\nThe polyline is not selected. Completion.") (princ) ) (progn ;; 1) Step Request (setq step (getreal "\nEnter the step between the centers (??): ") ) (if (or (null step) (<= step 0.0)) (setq step 50.0) ;; the "backup" option ) ;; 2) Fixed radius (setq radius 25.0) ;; 3) List of vertices (minimum 3, otherwise not a polygon) (setq vlist (getPolyVertices ent)) (if (< (length vlist) 3) (progn (prompt "\nThe polyline has <3 vertices, and the contour is incorrect." ) (princ) ) (progn ;; 4) Defining bounding box (setq minx (apply 'min (mapcar 'car vlist)) maxx (apply 'max (mapcar 'car vlist)) miny (apply 'min (mapcar 'cadr vlist)) maxy (apply 'max (mapcar 'cadr vlist)) ) (prompt (strcat "\nboundary (bounding box) polyline:\n" " X: " (rtos minx 2 2) " ... " (rtos maxx 2 2) "\n Y: " (rtos miny 2 2) " ... " (rtos maxy 2 2) ) ) ;; 5) Building a grid "in a staggered manner" (setq row 0 y miny ) (setq osmant (getvar "osmode")) (setvar "osmode" 0) (while (<= y maxy) ;; For an odd row row, we shift X by step/2 (if (oddp row) (setq x (+ minx (/ step 2.0))) (setq x minx) ) (while (<= x maxx) (setq pt (list x y)) ;; If the center is inside the polyline, draw a circle. (if (comprobar_centralidad pt vlist) ;(pointInPolygon pt vlist) (command "_.CIRCLE" pt radius) ) (setq x (+ x step)) ) (setq y (+ y step)) (setq row (1+ row)) ) (setvar "osmode" osmant) ) ) ) ) (princ) )
    1 point
  39. Or write at the beginning of the code: (setvar "osmode" 0)
    1 point
  40. As I told you before, turn off object snapping - it looks like it's on with endpoint and midpoint
    1 point
  41. I think you haven't implemented it right. Try this one (defun c:Circles_Chess_outl (/ oddp ent step radius vlist minx miny maxx maxy x y row pt ) ;;----------------------------------------------- ;; THE FUNCTION OF CHECKING WHETHER THE NUMBER IS ODD ;;----------------------------------------------- (defun oddp (n) (= (logand (fix n) 1) 1) ) ;;----------------------------------------------- ;; Local auxiliary functions ;;----------------------------------------------- ;; Extracting a list of vertices (points) of a linear 2D polyline: (defun getPolyVertices (e / ed lst pts) (setq ed (entget e) ;; selecting all groups of the DXF = 10 code (coordinates of the vertices) lst (vl-remove-if-not '(lambda (x) (= (car x) 10)) ed ) ;; turning them into a regular list of points (x y) pts (mapcar 'cdr lst) ) pts ) ;; Checking whether the pt point is located inside the linear polygon v list: ;;; (defun pointInPolygon (pt vlist / cnt i v1 v2) ;;; (setq cnt 0 ;;; i 0 ;;; ) ;;; ;; "Let's "block" the list so that we can bypass the pair (list[i], list[i+1]): ;;; (setq vlist (append vlist (list (car vlist)))) ;;; (repeat (1- (length vlist)) ;;; (setq v1 (nth i vlist) ;;; v2 (nth (1+ i) vlist) ;;; i (1+ i) ;;; ) ;;; (if (edgeIntersectsRay pt v1 v2) ;;; (setq cnt (1+ cnt)) ;;; ) ;;; ) ;;; ;; If the number of intersections with the ray is odd, the point inside ;;; (if (= (logand cnt 1) 1) ;;; T ;;; nil ;;; ) ;;; ) (defun comprobar_centralidad (pto lst_ptos_rto / pt_inters+ pt_inters- n pt1 pt2 inters_negat inters_posit ) (setq n 0) (repeat (- (length lst_ptos_rto) 1) (setq pt_inters+ (inters pto (list (+ (car pto) 100000) (cadr pto)) (setq pt1 (nth n lst_ptos_rto)) (setq pt2 (nth (+ n 1) lst_ptos_rto)) ) ) (if (and pt_inters+ (not (member (cons 10 pt_inters+) lst_ptos_rto)) ) (if inters_posit (setq inters_posit (+ inters_posit 1)) (setq inters_posit 1) ) ) (setq pt_inters- (inters pto (list (- (car pto) 100000) (cadr pto)) pt1 pt2 ) ) (if (and pt_inters- (not (member (cons 10 pt_inters-) lst_ptos_rto)) ) (if inters_negat (setq inters_negat (+ inters_negat 1)) (setq inters_negat 1) ) ) (setq n (+ n 1)) ) (if (and (= (rem (if (not inters_negat) 0 inters_negat ) 2 ) 0 ) (= (rem (if (not inters_posit) 0 inters_posit ) 2 ) 0 ) ) nil T ) ) ;; Checking the intersection of the horizontal ray to the right of pt with the segment (v1,v2): (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2) (setq px (car pt) py (cadr pt) x1 (car v1) y1 (cadr v1) x2 (car v2) y2 (cadr v2) ) ;; Let's ensure that (x1,y1) is "lower" than (x2,y2): (if (> y1 y2) (progn (setq x1 (car v2) y1 (cadr v2) x2 (car v1) y2 (cadr v1) ) ) ) ;; Intersection condition: (and ;; 1) py is strictly above the lower vertex and not higher than the upper one (> py y1) (<= py y2) ;; 2) px < abscissas of the intersection point of the ray with the segment (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2 intersectX) (setq px (car pt) py (cadr pt) x1 (car v1) y1 (cadr v1) x2 (car v2) y2 (cadr v2) ) ) ;; Let's ensure that (x1,y1) is "lower" than (x2,y2) (if (> y1 y2) (setq x1 (car v2) y1 (cadr v2) x2 (car v1) y2 (cadr v1) ) ) ) ;; Counting the intersection coordinate (setq intersectX (if (/= y2 y1) (+ x1 (* (- py y1) (/ (- x2 x1) (- y2 y1)))) x1 ;; if the segment is horizontal, it is usually skipped. ) ) ;; We are returning (and ...), or nil (and (> py y1) ;; a point above the lower vertex (<= py y2) ;; and no higher than the top (> intersectX px) ) ) ;;----------------------------------------------- ;; the main part ;;----------------------------------------------- (setq ent (car (entsel "\nChoose a closed linear polyline: "))) (if (null ent) (progn (prompt "\nThe polyline is not selected. Completion.") (princ) ) (progn ;; 1) Step Request (setq step (getreal "\nEnter the step between the centers (??): ") ) (if (or (null step) (<= step 0.0)) (setq step 50.0) ;; the "backup" option ) ;; 2) Fixed radius (setq radius 25.0) ;; 3) List of vertices (minimum 3, otherwise not a polygon) (setq vlist (getPolyVertices ent)) (if (< (length vlist) 3) (progn (prompt "\nThe polyline has <3 vertices, and the contour is incorrect." ) (princ) ) (progn ;; 4) Defining bounding box (setq minx (apply 'min (mapcar 'car vlist)) maxx (apply 'max (mapcar 'car vlist)) miny (apply 'min (mapcar 'cadr vlist)) maxy (apply 'max (mapcar 'cadr vlist)) ) (prompt (strcat "\nboundary (bounding box) polyline:\n" " X: " (rtos minx 2 2) " ... " (rtos maxx 2 2) "\n Y: " (rtos miny 2 2) " ... " (rtos maxy 2 2) ) ) ;; 5) Building a grid "in a staggered manner" (setq row 0 y miny ) (while (<= y maxy) ;; For an odd row row, we shift X by step/2 (if (oddp row) (setq x (+ minx (/ step 2.0))) (setq x minx) ) (while (<= x maxx) (setq pt (list x y)) ;; If the center is inside the polyline, draw a circle. (if (comprobar_centralidad pt vlist);(pointInPolygon pt vlist) (command "_.CIRCLE" pt radius) ) (setq x (+ x step)) ) (setq y (+ y step)) (setq row (1+ row)) ) ) ) ) ) (princ) )
    1 point
  42. I wouldn't rely on the attribute order, but rather acquire the attribute reference entity using its tag identifier, e.g.: (cond ( (not (setq ent (car (entsel))))) ( (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent))))) (princ "Selected object is not a block.") ) ( (/= 1 (cdr (assoc 66 enx))) (princ "\nSelected block is not attributed.") ) ( (progn (setq att (entnext ent) atx (entget att) ) (while (and (= "ATTRIB" (cdr (assoc 0 atx))) (/= "AREA" (cdr (assoc 2 atx)))) (setq att (entnext att) atx (entget att) ) ) (= "SEQEND" (cdr (assoc 0 atx))) ) (princ "\nAREA attribute not found in selected block.") ) ( (LM:fieldobjects att) ) )
    1 point
  43. @pkenewell its going to be 38c tomorrow, here in AUS, so going down the beach. Mind you they say thunderstorms will hits us in the afternoon. So we may get flooding, we are in our fire season I have bushland near my home so keep watch of what is going on. After California fires pointed out you have to be prepared.
    1 point
  44. This is another that could be used as a start point just work out max rows and columns rather than enter. ; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/rectangular-array-creating-every-other-row-offset/td-p/9667120 ; array rows a 1/2 x spacings ; Enter -ve values to change direction. ;By AlanH info@alanh.com.au Aug 2020 (defun c:zigzag ( / ent ss ans hor ver numx numy x ) (setq ent (entsel "\nSelect object to array")) (setq ss (ssadd)) (ssadd (car ent) ss) (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (setq ans (AH:getvalsm (list "Enter spacings " "Horizontal " 5 4 "100" "Vertical" 5 4 "50" "Num X " 5 4 "3" "Num Y" 5 4 "3"))) (setq hor (atof (nth 0 ans))) (setq ver (atof (nth 1 ans))) (setq numx (atoi (nth 2 ans))) (setq numy (atoi (nth 3 ans))) (setq x 1.0) (repeat (- numx 1) (command "copy" ent "" (list 0.0 0.0) (list (* x hor) 0.0) ) (ssadd (entlast) ss) (setq x (+ x 1)) ) (setq x 1.0) (while (< x numy) (command "copy" ss "" (list 0.0 0.0) (list (* 0.5 (- hor)) (* x ver))) (setq x (+ x 2)) ) (setq x 2.0) (while (< x numy) (command "copy" ss "" (list 0.0 0.0) (list 0.0 (* ver x))) (setq x (+ x 2)) ) (princ) ) (c:zigzag) Multi GETVALS.lsp
    1 point
  45. Circles are created with 'command': this means that they are object-snap sensitive. Always turn off object-snap to avoid undesired results. Or modify your code to turn off object-snap at the beginning of code execution.
    1 point
  46. Your 'pointInPolygon' function is not working as expected. I suggest you replace it with this one: (defun comprobar_centralidad (pto lst_ptos_rto / pt_inters+ pt_inters- n pt1 pt2 inters_negat inters_posit ) (setq n 0) (repeat (- (length lst_ptos_rto) 1) (setq pt_inters+ (inters pto (list (+ (car pto) 100000) (cadr pto)) (setq pt1 (nth n lst_ptos_rto)) (setq pt2 (nth (+ n 1) lst_ptos_rto)) ) ) (if (and pt_inters+ (not (member (cons 10 pt_inters+) lst_ptos_rto)) ) (if inters_posit (setq inters_posit (+ inters_posit 1)) (setq inters_posit 1) ) ) (setq pt_inters- (inters pto (list (- (car pto) 100000) (cadr pto)) pt1 pt2 ) ) (if (and pt_inters- (not (member (cons 10 pt_inters-) lst_ptos_rto)) ) (if inters_negat (setq inters_negat (+ inters_negat 1)) (setq inters_negat 1) ) ) (setq n (+ n 1)) ) (if (and (= (rem (if (not inters_negat) 0 inters_negat ) 2 ) 0 ) (= (rem (if (not inters_posit) 0 inters_posit ) 2 ) 0 ) ) nil T ) )
    1 point
  47. @pkenewell, This works like a dream!!! My nightmares are over Thank you for all you time, effort and patience. I owe you a good few beers!! I assume you are not from South Africa, there seems to be a time difference in our communication, otherwise I would buy you one in person. If you ever need any assistance with Plant 3D, please do not hesitate to contact me, I would be more than willing to try to assist, no guarantees though Thanks again for the help!!!
    1 point
  48. Hi all, those codes are perfect thank you! It doesn't matter that it creates a duplicate for the purpose of my task. Thanks again.
    1 point
  49. This task has been answered many times before, just find the outside rectangs and plot them. If the rectangs are blocks its even easier to do. In either case you get the two corners from the object for the plot window. Here is an example. ; simple plot titles in model ; By AlanH (defun plotmodel ( / oldsnap ss2 n xmin xmax xymin ymax ymin index en el inspt) (PROMPT ".....PRINTING DRAWING TO plotter....") (setq oldsnap (getvar "osmode")) (setvar "osmode" 0) (setq ss2 (ssget "x" '((0 . "INSERT")(2 . "A3-plotkader")(410 . "Model")))) ; A3-plotkader is the name of the title block (setq n (sslength ss2)) (setq index 0) (repeat n (setq en (ssname ss2 index)) (setq el (entget en)) (setq inspt (assoc 10 el)) ; insertion pt (setq xmin (- (cadr inspt) 6.0)) (setq ymin (- (caddr inspt) 6.0)) (setq xymin (strcat (rtos xmin 2 1) "," (rtos ymin 2 1))) (setq xmax (+ xmin 813.0)) ; hard coded for 813 wide 6mm offset (setq ymax (+ ymin 566.0)) ;hard coded for 566 high (setq xymax (strcat (rtos xmax 2 1) "," (rtos ymax 2 1))) (COMMAND "-PLOT" "Y" "" "Dwg To Pdf" "A3" "M" "LANDSCAPE" "N" "W" xymin xymax "1=2" "C" "y" "Acad.ctb" "Y" "" "n" "n" "y" ) (setq index (+ index 1)) ) (setvar "osmode" oldsnap) (princ) ) (plotmodel) Post a sample dwg only need 1 outside rectang or block.
    1 point
  50. In the bottom right corner of AutoCAD, click on the upside down triangle. Check that there is a tick next to Paper/Model. If there is not, then select it. Now at the bottom of your screen, where ORTHO, OSNAP, etc is there will be a button which will say PAPER or MODEL depending on if you are in paperspace or modelspace/viewport. If you are in a viewport and it says model, then just click it and it will change to paper and take you out of the viewport. Let me know if you are unsure about this and I will post a screenshot. Alternatively, type PSPACE at the command line.
    1 point
×
×
  • Create New...