ojacomarket Posted April 5, 2020 Posted April 5, 2020 Dear friends, I'm new here. But I'm tryin to combine AUTOLISP functions as ssget, assoc, enget etc to get a signle function , that will allow to select on one of the circles, press enter, and it will draw a polyline between circles that are located in the same LAYER. Do you have any ideas? With best regards, Arti Quote
Jonathan Handojo Posted April 5, 2020 Posted April 5, 2020 It's hard to imagine a picture on the head without an image or dwg sample. Could you perhaps post one? Quote
ojacomarket Posted April 5, 2020 Author Posted April 5, 2020 1 hour ago, Jonathan Handojo said: It's hard to imagine a picture on the head without an image or dwg sample. Could you perhaps post one? I have 4 + 4 circles, they have layer 0 matched But they have different text written nearby. So I want to CAD recognoze the text and draw one PLINE between H, and another between H1 Thank you for your response Quote
Jonathan Handojo Posted April 5, 2020 Posted April 5, 2020 (edited) Could you perhaps post an image of the final result you're after? Plus, it would be a lot easier if those were blocks whose attributes are H and H1 and the insertion points of the blocks are at the center of the circle. Edited April 5, 2020 by Jonathan Handojo Quote
BIGAL Posted April 6, 2020 Posted April 6, 2020 It looks like circles with H1 or H next to them so that's ok and finding the circles is ok. Now the problems are they always laid out like the image so the line joins left to right ? The biggest problem with auto can be the randomness of the circle positions. Can you post a real dwg for testing. Quote
ojacomarket Posted April 7, 2020 Author Posted April 7, 2020 (edited) On 4/6/2020 at 3:51 AM, BIGAL said: It looks like circles with H1 or H next to them so that's ok and finding the circles is ok. Now the problems are they always laid out like the image so the line joins left to right ? The biggest problem with auto can be the randomness of the circle positions. Can you post a real dwg for testing. Thank you for reply, The thing is, that those "H" and "H1" are always on the same position relative to circles (let's assume it is 5 m to X and 5 m to Y). And finding circles with ssget is also OK. But for now I want just to CAD recognize the "TEXT" nearby circle and draw line between circles, which are marked with same text, so after I can figure out how to put them in the SAME layer and join those line into poly. In addition, it is no problem which direction CAD will construct lines, since the point is to recognize TEXT nearby and use this constant, which I mentioned above to put line into center of circle, I rather would say the circles don't need in that case, the main object is TEXT. With best regards, test.dwg Edited April 7, 2020 by ojacomarket Quote
ojacomarket Posted April 7, 2020 Author Posted April 7, 2020 3 hours ago, ojacomarket said: Thank you for reply, The thing is, that those "H" and "H1" are always on the same position relative to circles (let's assume it is 5 m to X and 5 m to Y). And finding circles with ssget is also OK. But for now I want just to CAD recognize the "TEXT" nearby circle and draw line between circles, which are marked with same text, so after I can figure out how to put them in the SAME layer and join those line into poly. In addition, it is no problem which direction CAD will construct lines, since the point is to recognize TEXT nearby and use this constant, which I mentioned above to put line into center of circle, I rather would say the circles don't need in that case, the main object is TEXT. With best regards, test.dwg 626.67 kB · 2 downloads I actually have the example of code, since I'm not so good at LISP, so I study yet, I don't know such complicated LISPs, I used simple ones and I got result, but not what I expected, for some reason the "PLINE" command applies only to my last two circles ENDPOINT and STARTPOINT, but as seen from code it supposed to connect all 10 circles with single PLINE. I also pinned the result of that code..as .png Code: (defun c:PLtrace () (setq list1 '()) ;create just list (setq circleset1 (ssget "x" '((0 . "CIRCLE") (8 . "mootmpunkt")))) ;select all circles (they should be 10) (setq circleset1length1 (sslength circleset1)) ; (checkin' how many circles in there (setq circlenum1 (- 1 )) ;variable for loop (repeat circleset1length1 ;loop on selection set (setq circlenum1 (1+ circlenum1)) ;new value of variable (setq circlenames (entget (ssname circleset1 circlenum1))) ;get names of variable of set (setq circlecoords1 (cdr (assoc 10 circlenames))) ;taking coordinates of centers of the circles (setq list1 (append list1 (list circlecoords1))) ; making list with those coordinates ) ;end repeat1 (setq pl_com1 (- 1)) ;new variable for new loop (setq pl_length1 (length list1)) ;length of list of coordinates list1 (repeat pl_length1 ;new loop (setq pl_com1 (+ 1 pl_com1)) ;new value for variable inside loop, start point of PLINE (setq pl_com3 (+ 1 pl_com1)) ;new value for variable ENDPOINT of PLINE (setq nomer_1 (nth pl_com1 list1)) ;taking out first element of list1, which is start point of pline (setq nomer_2 (nth pl_com3 list1));taking out first element of list1, which is end point of pline (command "PLINE" nomer_1 nomer_2) ; command pline which should take nomer1 nomer2 values to make pline ) ; end repeat2 (princ) ) ;end defun Quote
Jonathan Handojo Posted April 8, 2020 Posted April 8, 2020 (edited) Something like this? (defun c:textcircle ( / circles dets ent i pl ss texts txt unique) (defun unique (lst / rtn) (while lst (setq rtn (cons (car lst) rtn) lst (vl-remove (car lst) lst) ) ) (reverse rtn) ) (if (setq ss (ssget '((0 . "CIRCLE,TEXT,MTEXT")))) (progn (repeat (setq i (sslength ss)) (if (eq (cdr (assoc 0 (entget (setq ent (ssname ss (setq i (1- i))))))) "CIRCLE") (setq circles (cons ent circles)) (setq texts (cons ent texts)) ) ) (foreach x circles (if (setq txt (car (vl-member-if '(lambda (y) (equal (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget y))) 1e-8 ) ) texts ) ) ) (setq dets (cons (cons (cdr (assoc 1 (entget txt))) x) dets)) ) ) (foreach x (unique (mapcar 'car dets)) (entmake (append '( (0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") ) (list (cons 90 (length (setq pl (vl-remove-if-not '(lambda (y) (eq x (car y))) dets))))) (apply 'append (mapcar '(lambda (y) (list (assoc 10 (entget (cdr y))) '(40 . 0) '(41 . 0) '(42 . 0) '(91 . 0) ) ) pl ) ) ) ) ) ) ) (princ) ) Edited April 8, 2020 by Jonathan Handojo 1 Quote
BIGAL Posted April 8, 2020 Posted April 8, 2020 (edited) The task is not that hard but again the randomness of how the dwg was put together will determine how the pline is drawn. My attempt ; simple join circles next to text. ; by Alan H April info@alanh.com.au (defun c:toff (/ CEN CO-ORD ENT INS LAY LST OBJ OBJ2 OFFD OLDSNAP RAD SS SS2 STR X) (setq offd 0.1) ; change to (setq offd (getreal "\nEnter offset")) if text is further away (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq ent (entget (car (entsel "\nPick text for layer and value")))) (setq lay (cdr (assoc 8 ent))) (setq str (cdr (assoc 1 ent))) (setq ss (ssget (list (cons 0 "*TEXT") (cons 8 lay) (cons 1 str)))) (setq lst '()) (repeat (setq x (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) (setq ins (vlax-get Obj 'insertionPoint)) (setq rad (* 1.5 (vlax-get Obj 'Height))) (command "polygon" 20 ins "I" rad) ;Autocad (setq obj2 (entlast)) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj2)))) (command "erase" obj2 "") (setq ss2 (ssget "F" co-ord (list (cons 0 "Circle")))) (setq cen (vlax-get (vlax-ename->vla-object (ssname ss2 0)) 'center)) (setq lst (cons cen lst)) ) (command "_pline") (while (= (getvar "cmdactive") 1) (repeat (setq x (length lst)) (command (nth (setq x (- x 1)) lst)) ) (command "") ) (setvar 'osmode oldsnap) (princ) ) Edited April 8, 2020 by BIGAL 1 Quote
Jonathan Handojo Posted April 8, 2020 Posted April 8, 2020 9 hours ago, ojacomarket said: The thing is, that those "H" and "H1" are always on the same position relative to circles (let's assume it is 5 m to X and 5 m to Y). And finding circles with ssget is also OK. But for now I want just to CAD recognize the "TEXT" nearby circle and draw line between circles, which are marked with same text, so after I can figure out how to put them in the SAME layer and join those line into poly. If all you want to do is moving them to the same layer, you don't need polylines. Simply get a unique list of texts and circles, and can simply use entmod. 25 minutes ago, BIGAL said: The task is not that hard but again the randomness of how the dwg was put together will determine how the pline is drawn. I agree there, unless of course the selection itself is in order... Quote
ojacomarket Posted April 8, 2020 Author Posted April 8, 2020 3 hours ago, BIGAL said: The task is not that hard but again the randomness of how the dwg was put together will determine how the pline is drawn. My attempt ; simple join circles next to text. ; by Alan H April info@alanh.com.au (defun c:toff (/ CEN CO-ORD ENT INS LAY LST OBJ OBJ2 OFFD OLDSNAP RAD SS SS2 STR X) (setq offd 0.1) ; change to (setq offd (getreal "\nEnter offset")) if text is further away (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq ent (entget (car (entsel "\nPick text for layer and value")))) (setq lay (cdr (assoc 8 ent))) (setq str (cdr (assoc 1 ent))) (setq ss (ssget (list (cons 0 "*TEXT") (cons 8 lay) (cons 1 str)))) (setq lst '()) (repeat (setq x (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) (setq ins (vlax-get Obj 'insertionPoint)) (setq rad (* 1.5 (vlax-get Obj 'Height))) (command "polygon" 20 ins "I" rad) ;Autocad (setq obj2 (entlast)) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj2)))) (command "erase" obj2 "") (setq ss2 (ssget "F" co-ord (list (cons 0 "Circle")))) (setq cen (vlax-get (vlax-ename->vla-object (ssname ss2 0)) 'center)) (setq lst (cons cen lst)) ) (command "_pline") (while (= (getvar "cmdactive") 1) (repeat (setq x (length lst)) (command (nth (setq x (- x 1)) lst)) ) (command "") ) (setvar 'osmode oldsnap) (princ) ) Thank you very much! As I said, I'm not so smart at LISP, beacause still learning, but I see there new for me function "vlax" and "lambda" I will go through them and then it is clear for me. Again thank you for your time! Quote
ojacomarket Posted April 8, 2020 Author Posted April 8, 2020 2 hours ago, Jonathan Handojo said: If all you want to do is moving them to the same layer, you don't need polylines. Simply get a unique list of texts and circles, and can simply use entmod. I agree there, unless of course the selection itself is in order... Thank you as much as for BIGAL, you helped indeed, but I need a bit learning of those new functions, then I could understand how programm works, it is much better for me. But your code is excellent! Quote
BIGAL Posted April 8, 2020 Posted April 8, 2020 have a look at this (defun c:toff (/ CEN CO-ORD ENT INS LAY LST OBJ OBJ2 OFFD OLDSNAP RAD SS SS2 STR X) (setq oldsnap (getvar 'osmode)) ; save current osnaps (setvar 'osmode 0) ; turn off osnaps (setq ent (entget (car (entsel "\nPick text for layer and value")))) ; select a text obect (setq lay (cdr (assoc 8 ent))) ; get object layer dxf code 8 (setq str (cdr (assoc 1 ent))) ; get object text dxf code 1 (setq ss (ssget (list (cons 0 "*TEXT") (cons 8 lay) (cons 1 str)))) ; get objects that are text on layer plus text string (setq lst '()) ; set list to blank in case exists already (repeat (setq x (sslength ss)) ; do for every text in slection (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) ; get each item in selection set (setq ins (vlax-get Obj 'insertionPoint)) ; get text insertion point (setq rad (* 1.5 (vlax-get Obj 'Height))) ; dummy value for a polygon to look for a nearby Circle (command "polygon" 20 ins "I" rad) ;Autocad Note briscad is different (setq obj2 (entlast)) ; save the name of the last object created (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj2)))) ; loops through the pline vertice points (command "erase" obj2 "") ; no longer required as needed points (setq ss2 (ssget "F" co-ord (list (cons 0 "Circle")))) ; looks for circles that touch the polygon (setq cen (vlax-get (vlax-ename->vla-object (ssname ss2 0)) 'center)) ; gets the center point of the circle (setq lst (cons cen lst)) ; makes a list of all the pline points ) (command "_pline") ; start pline command (while (= (getvar "cmdactive") 1) ; is pline running (repeat (setq x (length lst)) ; repeat for all the points (command (nth (setq x (- x 1)) lst)) ; pass the point co-ords to the pline command ) (command "") ; end pline ) (setvar 'osmode oldsnap) ; reset the osnaps (princ) ; quite exit of defun ) 1 Quote
ojacomarket Posted April 8, 2020 Author Posted April 8, 2020 1 hour ago, BIGAL said: have a look at this (defun c:toff (/ CEN CO-ORD ENT INS LAY LST OBJ OBJ2 OFFD OLDSNAP RAD SS SS2 STR X) (setq oldsnap (getvar 'osmode)) ; save current osnaps (setvar 'osmode 0) ; turn off osnaps (setq ent (entget (car (entsel "\nPick text for layer and value")))) ; select a text obect (setq lay (cdr (assoc 8 ent))) ; get object layer dxf code 8 (setq str (cdr (assoc 1 ent))) ; get object text dxf code 1 (setq ss (ssget (list (cons 0 "*TEXT") (cons 8 lay) (cons 1 str)))) ; get objects that are text on layer plus text string (setq lst '()) ; set list to blank in case exists already (repeat (setq x (sslength ss)) ; do for every text in slection (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) ; get each item in selection set (setq ins (vlax-get Obj 'insertionPoint)) ; get text insertion point (setq rad (* 1.5 (vlax-get Obj 'Height))) ; dummy value for a polygon to look for a nearby Circle (command "polygon" 20 ins "I" rad) ;Autocad Note briscad is different (setq obj2 (entlast)) ; save the name of the last object created (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj2)))) ; loops through the pline vertice points (command "erase" obj2 "") ; no longer required as needed points (setq ss2 (ssget "F" co-ord (list (cons 0 "Circle")))) ; looks for circles that touch the polygon (setq cen (vlax-get (vlax-ename->vla-object (ssname ss2 0)) 'center)) ; gets the center point of the circle (setq lst (cons cen lst)) ; makes a list of all the pline points ) (command "_pline") ; start pline command (while (= (getvar "cmdactive") 1) ; is pline running (repeat (setq x (length lst)) ; repeat for all the points (command (nth (setq x (- x 1)) lst)) ; pass the point co-ords to the pline command ) (command "") ; end pline ) (setvar 'osmode oldsnap) ; reset the osnaps (princ) ; quite exit of defun ) Explanation is so clear, that I now have an idea how it really works, thank you for your help. I will proceede with those tasks and continue to study those commands. I can see that vlax is used quite often in LISP. Quote
dlanorh Posted April 8, 2020 Posted April 8, 2020 I think you'll find that the insertion point of the text is the same as the centre of the circle (Top Left) and each text is preceeded by a space. The line is a shortest route problem, so you perhaps find the convex hull of each set of points (H & H1) as a starting pint, work from there then remove the longest segment.IIRC the last time this came up was about 1.5 - 2 years ago (no more) on the Autodesk forums 1 Quote
dlanorh Posted April 8, 2020 Posted April 8, 2020 Try this mishmash of routines. I've tried it in a dozen scenarios and point configurations and it seems to work, but I have a feeling I'm missing a case where it might fail. (vl-load-com) (defun rh:emLWP (lst cls) (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (x) (cons 10 x))) lst) );end_append );end_entmakex );end_defun (defun rh:mslen (ent / sp ep obj vlst lst msl) (setq sp 0 ep (vlax-curve-getendparam ent) vlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))) (while (< sp ep) (setq lst (cons (list sp (- (vlax-curve-getdistatparam ent (1+ sp)) (vlax-curve-getdistatparam ent sp))) lst) sp (1+ sp))) (setq lst (reverse lst) msl (vl-position (car (vl-sort lst '(lambda (x y) (> (cadr x) (cadr y))))) lst)) (while (not (minusp msl)) (setq vlst (append (cdr vlst) (list (car vlst))) msl (1- msl))) (entdel ent) (rh:emLWP vlst 0) );end_defun (defun _gp ( lst / sp cnt d n z ) (cond (lst (setq d (distance (car lst) (cadr lst)) sp (car lst)) (foreach x (setq z lst) (foreach y (setq z (cdr z)) (if (< d (setq n (distance x y))) (setq d n sp x)))) (setq lst (mapcar '(lambda (x) (reverse (cdr (reverse x)))) lst)) (rh:mslen (rh:emLWP lst 1)) ) );end_cond );end_defun (defun c:test ( / ss cnt ent elst ipt h_lst h1_lst) (setq ss (ssget '((0 . "TEXT")(8 . "Punkti_kood")))) (cond (ss (repeat (setq cnt (sslength ss)) (setq ent (ssname ss (setq cnt (1- cnt))) elst (entget ent) ipt (cdr (assoc (if (and (= (cdr (assoc 72 elst)) 0) (= (cdr (assoc 73 elst)) 0)) 10 11) elst)) );end_setq (if (= (cdr (assoc 1 elst)) " H") (setq h_lst (cons ipt h_lst)) (setq h1_lst (cons ipt h1_lst))) );end_repeat ) );end_cond (foreach x (list h_lst h1_lst) (if x (_gp x))) (princ) );end_defun 1 Quote
ojacomarket Posted April 8, 2020 Author Posted April 8, 2020 3 hours ago, dlanorh said: Try this mishmash of routines. I've tried it in a dozen scenarios and point configurations and it seems to work, but I have a feeling I'm missing a case where it might fail. (vl-load-com) (defun rh:emLWP (lst cls) (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (x) (cons 10 x))) lst) );end_append );end_entmakex );end_defun (defun rh:mslen (ent / sp ep obj vlst lst msl) (setq sp 0 ep (vlax-curve-getendparam ent) vlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))) (while (< sp ep) (setq lst (cons (list sp (- (vlax-curve-getdistatparam ent (1+ sp)) (vlax-curve-getdistatparam ent sp))) lst) sp (1+ sp))) (setq lst (reverse lst) msl (vl-position (car (vl-sort lst '(lambda (x y) (> (cadr x) (cadr y))))) lst)) (while (not (minusp msl)) (setq vlst (append (cdr vlst) (list (car vlst))) msl (1- msl))) (entdel ent) (rh:emLWP vlst 0) );end_defun (defun _gp ( lst / sp cnt d n z ) (cond (lst (setq d (distance (car lst) (cadr lst)) sp (car lst)) (foreach x (setq z lst) (foreach y (setq z (cdr z)) (if (< d (setq n (distance x y))) (setq d n sp x)))) (setq lst (mapcar '(lambda (x) (reverse (cdr (reverse x)))) lst)) (rh:mslen (rh:emLWP lst 1)) ) );end_cond );end_defun (defun c:test ( / ss cnt ent elst ipt h_lst h1_lst) (setq ss (ssget '((0 . "TEXT")(8 . "Punkti_kood")))) (cond (ss (repeat (setq cnt (sslength ss)) (setq ent (ssname ss (setq cnt (1- cnt))) elst (entget ent) ipt (cdr (assoc (if (and (= (cdr (assoc 72 elst)) 0) (= (cdr (assoc 73 elst)) 0)) 10 11) elst)) );end_setq (if (= (cdr (assoc 1 elst)) " H") (setq h_lst (cons ipt h_lst)) (setq h1_lst (cons ipt h1_lst))) );end_repeat ) );end_cond (foreach x (list h_lst h1_lst) (if x (_gp x))) (princ) );end_defun Thank you very much, I'll try that code! Quote
ronjonp Posted April 9, 2020 Posted April 9, 2020 @ojacomarket Have you seen THIS thread? Here's a quick modification to connect circles, blocks and points: (defun c:path (/ _daisychain p pt pts s x) ;; RJP » 04.09.2020 (defun _daisychain (pt l / tmp out dsort) (defun dsort (pt l / d1 d2) (vl-sort l (function (lambda (d1 d2) (< (distance pt d1) (distance pt d2))))) ) (setq tmp (dsort pt l)) (while (setq tmp (dsort (car tmp) tmp)) (setq out (cons (car tmp) out)) (setq tmp (cdr tmp))) (reverse out) ) (cond ((and (setq p (getpoint "\nPick a point to sort from: ")) (setq s (ssget '((0 . "insert,circle,point")))) (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))) (setq pts (_daisychain p (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) s))) ) (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (assoc 8 (entget (car s))) (cons 90 (length s)) '(38 . 0.0) ) (mapcar '(lambda (x) (cons 10 x)) pts) (list '(210 0.0 0.0 1.0)) ) ) ) ) (princ) ) (vl-load-com) 1 Quote
ojacomarket Posted April 9, 2020 Author Posted April 9, 2020 4 hours ago, ronjonp said: @ojacomarket Have you seen THIS thread? Here's a quick modification to connect circles, blocks and points: (defun c:path (/ _daisychain p pt pts s x) ;; RJP » 04.09.2020 (defun _daisychain (pt l / tmp out dsort) (defun dsort (pt l / d1 d2) (vl-sort l (function (lambda (d1 d2) (< (distance pt d1) (distance pt d2))))) ) (setq tmp (dsort pt l)) (while (setq tmp (dsort (car tmp) tmp)) (setq out (cons (car tmp) out)) (setq tmp (cdr tmp))) (reverse out) ) (cond ((and (setq p (getpoint "\nPick a point to sort from: ")) (setq s (ssget '((0 . "insert,circle,point")))) (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))) (setq pts (_daisychain p (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) s))) ) (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (assoc 8 (entget (car s))) (cons 90 (length s)) '(38 . 0.0) ) (mapcar '(lambda (x) (cons 10 x)) pts) (list '(210 0.0 0.0 1.0)) ) ) ) ) (princ) ) (vl-load-com) Thank you very much I can see from your code new elements for me, so I have to understand them first then use, but I probably try that one. Thank you for you time! Quote
ronjonp Posted April 9, 2020 Posted April 9, 2020 4 minutes ago, ojacomarket said: Thank you very much I can see from your code new elements for me, so I have to understand them first then use, but I probably try that one. Thank you for you time! You're welcome! Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.