Jump to content

Connecter plusieurs blocs

choupi1968

By choupi1968
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

choupi1968 Apprentice

choupi1968

Posted
Posted

hello how to connect with a line or a polyline several blocks of different names with the same ADDRESS attribute names
In order 001 002 003 etc…
THANKS

mhupp Grand Master

mhupp

Posted
Posted

Sounds easy enough just need to make a selection set of the blocks

step thought the selection set pulling the entity name and attribute value into a list.

sort the list by the the attribute.

then process the list and pull the block base point.

fuccaro Grand Master

fuccaro

Posted
Posted

@mhupp

Do you mean something like this? 

(defun c:pp( / ssb)
  (setq ssb (ssget "X" '((0 . "INSERT")(66 . 1))) lst nil)
  (repeat (setq i (sslength ssb))
    (setq b1 (ssname ssb (setq i (1- i)))
	  poz (cdr (assoc 10 (entget b1))))
    (while (and (/= (cdr (assoc 0 (setq attl  (entget (setq b1 (entnext b1)))))) "SEQUEND")
		(/= (cdr (assoc 2 attl)) "ADDRESS")))
   (setq lst (cons (cons poz (cdr (assoc 1 attl))) lst))    
    )
  (setq lst (vl-sort lst '(lambda (x y) (< (cdr x) (cdr y))))
	lst (mapcar '(lambda (x) (cons 10 (car x))) lst))
  (foreach x (list (cons 90 (length lst)) '(100 . "AcDbPolyline") '(100 . "AcDbEntity") '(0 . "LWPOLYLINE"))
    (setq lst (cons x lst)))
  (entmake lst)
  )

 

choupi1968 Apprentice

choupi1968

Posted
  • Author
Posted

hello I expressed myself badly in my last post. the pp lisp works really well, but I'm looking for it to also work

if the "ADDRESS" attribute is indicated like this L1-001, L1-002, L1-003,...etc or B01-001,B01-002, B01-003...etc or 1/1/1-001, 1/1/1-002, 1/1/1-003 etc... with the lisp line

 

(list (cdr (assoc 1 (entget att))) (cdr (assoc 10 (entget blk))))

 

by tracing Arc polylines with

 

(command "_.pline" break "_arc") If anyone has any ideas THANKS

mhupp Grand Master

mhupp

Posted
Posted
4 hours ago, choupi1968 said:

hello I expressed myself badly in my last post.

 

Yes, it was one sentence. posting a sample drawing is usually best

 

choupi1968 Apprentice

choupi1968

Posted
  • Author
Posted
Quote

Hello, you are right with an autocad file it will be clearer, to explain what I want. Happy Sunday and thank you for your help. Sincerely Philip

 

TEST CABLAGE-001.dwg

fuccaro Grand Master

fuccaro

Posted
Posted

I am a bit confused now. The program I wrote should sort those attributes, whatever they contains. 

  • Like 1
Tsuky Community Regular

Tsuky

Posted
Posted

@choupi1968

@fuccaro 's code works fine.

With your exemple, you must just remove "X" at (ssget) and change the tag "ADDRESS" to "ORDRE""

 

  • Agree 1
  • Thanks 1
fuccaro Grand Master

fuccaro

Posted
Posted

Here is the program changed... almost as you requested. 

(defun c:pp( / ssb)
  (setq ssb (ssget '((0 . "INSERT")(66 . 1))) lst nil bulge 0.2)
  (repeat (setq i (sslength ssb))
    (setq b1 (ssname ssb (setq i (1- i)))
	  poz (cdr (assoc 10 (entget b1))))
    (while (and (/= (cdr (assoc 0 (setq attl  (entget (setq b1 (entnext b1)))))) "SEQUEND")
		(/= (cdr (assoc 2 attl)) "ORDRE")))
   (setq lst (cons (cons poz (cdr (assoc 1 attl))) lst))    
    )
  (setq lst (vl-sort lst '(lambda (x y) (< (cdr x) (cdr y))))
	lst (mapcar '(lambda (x) (cons 10 (car x))) lst))
  (setq l1 (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")'(100 . "AcDbPolyline")(cons 90 (length lst))))
  (foreach x lst
    (setq l1 (append l1 (list x)))
    (setq l1 (append l1 (list (cons 42 (setq bulge (- bulge))))))
    )
  (entmake l1)
  )

It will draw a curved polyline. Select it, than drag the ARC's midpoint to the desired position

choupi1968 Apprentice

choupi1968

Posted
  • Author
Posted (edited)

hello it's great I was just looking for a solution with the following lisp. thank you very much,

have a good evening.

Philippe.

  

(defun c:pl2arc ( / massoclst nthmassocsubst v^v unit _ilp doc lw enx gr enxb p1 p2 p3 b i n )

  (vl-load-com)

  (defun massoclst ( key lst )
    (if (assoc key lst) (cons (assoc key lst) (massoclst key (cdr (member (assoc key lst) lst)))))
  )

  (defun nthmassocsubst ( n key value lst / k slst p j plst m tst pslst )
    (setq k (length (setq slst (member (assoc key lst) lst))))
    (setq p (- (length lst) k))
    (setq j -1)
    (repeat p
      (setq plst (cons (nth (setq j (1+ j)) lst) plst))
    )
    (setq plst (reverse plst))
    (setq j -1)
    (setq m -1)
    (repeat k
      (setq j (1+ j))
      (if (equal (assoc key (member (nth j slst) slst)) (nth j slst) 1e-6)
        (setq m (1+ m))
      )
      (if (and (not tst) (= n m))
        (setq pslst (cons (cons key value) pslst) tst t)
        (setq pslst (cons (nth j slst) pslst))
      )
    )
    (setq pslst (reverse pslst))
    (append plst pslst)
  )

  (defun v^v ( u v )
    (mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1))
  )

  (defun unit ( v )
    (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
  )

  (defun _ilp ( p1 p2 o nor / p1p p2p op tp pp p )
    (if (not (equal (v^v nor (unit (mapcar '- p2 p1))) '(0.0 0.0 0.0) 1e-7))
      (progn
        (setq p1p (trans p1 0 (v^v nor (unit (mapcar '- p2 p1))))
              p2p (trans p2 0 (v^v nor (unit (mapcar '- p2 p1))))
              op  (trans o 0 (v^v nor (unit (mapcar '- p2 p1))))
              op  (list (car op) (cadr op) (caddr p1p))
              tp  (polar op (+ (* 0.5 pi) (angle '(0.0 0.0 0.0) (trans nor 0 (v^v nor (unit (mapcar '- p2 p1)))))) 1.0)
        )
        (if (inters p1p p2p op tp nil)
          (progn
            (setq p (trans (inters p1p p2p op tp nil) (v^v nor (unit (mapcar '- p2 p1))) 0))
            p
          )
          nil
        )
      )
      (progn
        (setq pp (list (car (trans p1 0 nor)) (cadr (trans p1 0 nor)) (caddr (trans o 0 nor))))
        (setq p (trans pp nor 0))
        p
      )
    )
  )

  (or doc (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
  (vla-startundomark doc)
  (if (and (setq lw (entsel "\nPick LWPOLYLINE..."))
          (= (cdr (assoc 0 (setq enx (entget (car lw))))) "LWPOLYLINE")
      )
    (progn
      (setq i (fix (vlax-curve-getParamAtPoint
                  (car lw)
                  (vlax-curve-getClosestPointToProjection (car lw) (trans (cadr lw) 1 0) '(0.0 0.0 1.0))
                  ) ;_  vlax-curve-getParamAtPoint
              ) ;_  fix
           p1 (vlax-curve-getPointAtParam (car lw) i)
           p3 (vlax-curve-getPointAtParam (car lw) (1+ i))
           lw (car lw)
      )
      (setq enxb (massoclst 42 enx))
      (while (= 5 (car (setq gr (grread t))))
        (setq p2 (_ilp (trans (cadr gr) 1 0) (mapcar '+ (trans (cadr gr) 1 0) '(0.0 0.0 1.0)) p1 (cdr (assoc 210 (entget lw)))))
        (setq b ((lambda (a) (/ (sin a) (cos a)))
                (/ (- (angle (trans p2 0 lw) (trans p3 0 lw)) (angle (trans p1 0 lw) (trans p2 0 lw))) 2.0)
               )
        )
        (setq n -1)
        (foreach dxf42 enxb
          (setq n (1+ n))
          (if (= n i)
            (setq enx (nthmassocsubst n 42 b enx))
            (setq enx (nthmassocsubst n 42 (+ (cdr dxf42) b) enx))
          )
        )
        (entupd (cdr (assoc -1 (entmod enx))))
      )
    )
    (prompt "\n Nothing selected or picked object not a LWPOLYLINE ")
  )
  (vla-endundomark doc)
  (princ)
)

 

Edited by fuccaro
Adding <>
fuccaro Grand Master

fuccaro

Posted
Posted

In the future, please use CODE tags to post ... well... code. 

I just added a bulge factor of +/- 0.2, I think is better than the Command... arc... as you suggested.

I see the curved polyline in the drawing you uploaded. How do you decide what radius to use for each polyline segment? Is there a formula that could be implemented in the Lisp program?

  • 3 weeks later...
choupi1968 Apprentice

choupi1968

Posted
  • Author
Posted

Hello, sorry for the late response, I got sick. thanks for the lisp PP. it is perfect and in my daily life it does not need to be improved... for the moment. Post a Code I'll be careful next time. THANKS I have another challenge to offer you: distribute X number of blocks in an irregular polygon. Regardless of the scale, size or surface area of the polygon. Kind regards Philip

XDSoft Contributor

XDSoft

Posted
Posted (edited)
On 3/15/2024 at 2:37 AM, choupi1968 said:

hello how to connect with a line or a polyline several blocks of different names with the same ADDRESS attribute names
In order 001 002 003 etc…
THANKS

 

Batch processing

 

https://www.theswamp.org/index.php?topic=59427.0

 

Rec0371.gif.2085c8381ca8b3745b701bdec7f1e386.gif

Edited by XDSoft
XDSoft Contributor

XDSoft

Posted
Posted (edited)

Rec0371.gif.2085c8381ca8b3745b701bdec7f1e386.gif

 

 

 

[XDrX-PlugIn(126)] Connecter attrib blocks by tag (theswamp.org)

https://www.theswamp.org/index.php?topic=59427.0

  

(defun c:xdtb_att-connect (/ att bulge delim ents i lst nums pl pts ss str str1 strl strl1 tag x y)
  (defun _get-data ()
    (and
      (setq att (car (xdrx-nentselex (xdrx-string-multilanguage "\n拾取要排序的属性标签字符串<退出>:" "\nPick the attribute label string to be sorted<Exit>:")
				     '((0 . "att*"))
		     )
		)
      )
      (setq tag (xdrx-getpropertyvalue att "tag"))
      (/= "" (setq delim (getstring (xdrx-string-multilanguage "\n属性分割符<退出>:"
							       "\nAttribute separator <exit>:"
				    )
			 )
	     )
      )
      (setq ss (xdrx-ssget (xdrx-string-multilanguage "\n选择属性块<退出>:"
						      "\nSelect attribute block <Exit>:"
			   ) '((0 . "insert") (66 . 1))
	       )
      )
    )
  )
  (defun _analyze-data ()
    (setq lst nil)
    (mapcar
      '(lambda (x)
	 (setq ents (xdrx-getpropertyvalue x "AttributeEntities"))
	 (if (vl-some '(lambda (y)
			 (if (= tag (xdrx-getpropertyvalue y "tag"))
			   (setq str (xdrx-getpropertyvalue y "textstring"))
			 )
		       ) ents
	     )
	   (progn
	     (if (setq str1 (xdrx-string-split str delim))
	       (setq lst (cons (list (car str1) str x) lst))
	     )
	   )
	 )
       )
      (xdrx-ss->ents ss)
    )
    (setq lst (xd::list:groupbyindex lst 0.1))
    (setq lst (mapcar
		'(lambda (x)
		   (setq strl (cdr x))
		   (setq strl1 (mapcar
				 'car
				 strl
			       )
			 strl1 (xdrx-string-sort strl1)
		   )
		   (mapcar
		     '(lambda (y)
			(assoc y strl)
		      )
		     strl1
		   )
		 )
		lst
	      )
    )
  )
  (defun _connect-line ()
    (setq bulge 0.155)
    (mapcar
      '(lambda (x)
	 (setq ents (mapcar
		      'cadr
		      x
		    )
	 )
	 (setq pts (xdrx-getpropertyvalue ents "position")
	       pts (apply
		     'append
		     pts
		   )
	 )
	 (setq pl (xdrx-polyline-make pts))
	 (setq nums (xdrx-getpropertyvalue pl "numverts"))
	 (setq i 0)
	 (repeat nums
	   (if (= (rem i 2) 1)
	     (setq bulge (- bulge))
	   )
	   (xdrx-setpropertyvalue pl "bulgeat" (list i bulge))
	   (setq i (1+ i))
	 )
       )
      lst
    )
  )
  (if (_get-data)
    (progn
      (xdrx-begin)
      (_analyze-data)
      (_connect-line)
      (xdrx-end)
    )
  )
  (princ)
)

 

Edited by XDSoft

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...