Connecter plusieurs blocs

[choupi1968]

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]

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]

@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]

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]

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]

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]

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

[Tsuky]

@choupi1968

@fuccaro 's code works fine.

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

 

[fuccaro]

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]

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 March 20 by fuccaro
Adding <>

[fuccaro]

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?

[choupi1968]

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

[BIGAL]

Post a before and after dwg.

[XDSoft]

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

 

Edited April 9 by XDSoft

[XDSoft]

 

 

 

[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 April 9 by XDSoft