Jump to content
Shablab

Insert Blocks at line intersections

Recommended Posts

Shablab

I currently have a lisp routine to place a block at intersection points with one main line (RED) and then all other lines (WHITE) that cross it. I have a problem and cant seem to figure out how to adjust the code to make it work more fluid. 

  • I would like the main line to be able to be crossed more than once by a different line and still work. Currently if a RED line is crossed twice by any single white line it will not work and the lisp will bottom out and end
(vl-load-com)
(defun c:sbx ( / )
  (progn
    (setq ent (car (entsel "\nSelect main line: ")))
    (if ent
      (progn
 (princ "\nSelect crossing line(s): ")
 (if (setq ss (ssget))
   (progn
     (setq count 0
    obj (vlax-ename->vla-object ent)
    pointlist nil
    )
     (repeat (sslength ss)
       (setq xent (ssname ss count)
      xobj (vlax-ename->vla-object xent)
      )
       (if (setq int (vla-IntersectWith obj xobj acExtendNone))
  (progn
    (setq int (vlax-safearray->list (vlax-variant-value int))
   pointlist (append pointlist (list int))
   )
    )
  )
       (setq count (1+ count))
       )
     (if (null (tblobjname "BLOCK" "SBblock"))
       (progn
  (entmake (list (cons 0 "BLOCK") (cons 2 "SBblock") (cons 70 0) (list 10 0.0 0.0 0.0)))
  (entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (8 . "0") (100 . "AcDbPolyline") (90 . 2) (70 . 1) (43 . 1.0) (38 . 0.0) (39 . 0.0)
      (10 2.5 0.0) (40 . 1.0) (41 . 1.0) (42 . 1.0) (91 . 0)
      (10 -2.5 0.0) (40 . 1.0) (41 . 1.0) (42 . 1.0) (91 . 0)
      (210 0.0 0.0 1.0)
      )
    )
  (setq blockname (entmake '((0 . "ENDBLK"))))
  )
       )
     (foreach pt_nth pointlist
       (entmake (append
    '((0 . "INSERT") (100 . "AcDbEntity") (8 . "0") (100 . "AcDbBlockReference") (2 . "SBblock"))
    (list (cons 10 pt_nth))
    '((41 . 1.0) (42 . 1.0) (43 . 1.0) (50 . 0.0) (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210 0.0 0.0 1.0))
    )
         )
       )
     )
   )
 )
      )
    )
  (princ)
  )

 

Share this post


Link to post
Share on other sites
BIGAL

If you have say an arc and a line it has 2 crossing points same with a pline may have many. Checked pline.

 

If you had google a little bit would have found this solution.  https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2016/ENU/AutoCAD-ActiveX/files/GUID-1243A593-5DAE-4DC3-B539-59FDA990E687-htm.html

 

When you get intersection with it does not reveal openly that it has a list of multiple points.


4 crossing pline

: (setq tempPoint (vlax-safearray->list (vlax-variant-value int)))
(-45.7897023657555 -68.0 0.0 -21.4420330485725 -68.0 0.0 14.5912162493923 -68.0 0.0 30.2655976536329 -68.0 0.0)

 

Note this (vlax-safearray-get-u-bound (vlax-variant-value intPoints) 1) will give a number of items in the list less 1 as it starts at 0. 

Share this post


Link to post
Share on other sites
dlanorh

This works but lightly tested

 

(vl-load-com)
(defun makeblock ()
  (entmake (list (cons 0 "BLOCK") (cons 2 "SBblock") (cons 70 0) (list 10 0.0 0.0 0.0)))
  (entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (8 . "0") (100 . "AcDbPolyline") (90 . 2) (70 . 1) (43 . 1.0) (38 . 0.0) (39 . 0.0)
      (10 2.5 0.0) (40 . 1.0) (41 . 1.0) (42 . 1.0) (91 . 0)
      (10 -2.5 0.0) (40 . 1.0) (41 . 1.0) (42 . 1.0) (91 . 0)
      (210 0.0 0.0 1.0)
      )
    )
  (entmake '((0 . "ENDBLK")))
)

(defun rh:sammlung_n (o_lst grp / tmp n_lst)
  (setq n_lst nil)
  (if (= (rem (length o_lst) grp) 0)
	(while o_lst
	  (repeat grp (setq tmp (cons (car o_lst) tmp) o_lst (cdr o_lst)))
	  (setq n_lst (cons (reverse tmp) n_lst) tmp nil)
	);end_while
	(princ "\nModulus Error : The passed list length is not exactly divisible by the group size!!")
  );end_if
  (if n_lst (reverse n_lst))
);end_defun rh:sammlung_n

(defun c:sbx ( / ent ss obj cnt xobj pt_lst)
  (if (null (tblobjname "BLOCK" "SBblock")) (makeblock))

  (setq ent (car (entsel "\nSelect main line: ")))
  (cond (ent
          (prompt "\nSelect crossing line(s): ")
          (setq ss (ssget '((0 . "ARC,CRCLE,ELLIPSE,*LINE,RAY"))))
          (cond (ss
                  (setq obj (vlax-ename->vla-object ent))
                  (repeat (setq cnt (sslength ss))
                    (setq xobj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt))))
                          pt_lst nil
                          pt_lst (vlax-invoke obj 'intersectwith xobj acExtendNone)      
                    )
                    (cond (pt_lst
                            (setq pt_lst (rh:sammlung_n pt_lst 3))
                            (foreach pt pt_lst
                              (entmake  (append
                                          '((0 . "INSERT") (100 . "AcDbEntity") (8 . "0") (100 . "AcDbBlockReference") (2 . "SBblock"))
                                          (list (cons 10 pt))
                                          '((41 . 1.0) (42 . 1.0) (43 . 1.0) (50 . 0.0) (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210 0.0 0.0 1.0))
                                        );end_append
                              );end_entmake
                            );end_foreach  
                          )
                    );end_cond
                  )
                )
          );end_cond
        )
  );end_cond        
  (princ)
)

 

The list returned by the intersectwith needed converting into a list of lists

 

(1.0 1.0 0.0 2.0 2.0 0.0) => ((1.0 1.0 0.0) (2.0 2.0 0.0))

Share this post


Link to post
Share on other sites
BIGAL

Dlanorh just a suggestion as you pick the line or pline can use ssget "F" to automatically select the other objects no need to pick them.

 

Please Note Briscad users "F" option will select the "Main" line have reported to Brisys.

 


(setq ent (car (entsel "\nSelect main line: ")))
(setq entnex (entget ent))
(setq lst '())
(setq name (cdr (assoc 0 entnex)))
(cond 
( (= name "LINE") (setq lst (cons (list (cadr (assoc 10 entnex)) (caddr (assoc 10 entnex))) lst))
                  (setq lst (cons (list (cadr (assoc 11 entnex)) (caddr (assoc 11 entnex))) lst))
)
( (= name "LWPOLYLINE") (setq lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) entnex))))
)

(setq ss (ssget "F" lst '((0 . "ARC,CRCLE,ELLIPSE,*LINE,RAY"))))
 

Share this post


Link to post
Share on other sites
dlanorh
1 hour ago, BIGAL said:

(setq lst '())

 

 

@BIGAL  :nono:

 

one of my pet peeves. What does (listp nil) return. :P

 

Have a good weekend. :beer:

Share this post


Link to post
Share on other sites
David Bethel

 

nil is evaluated as an empty list.

 

This keeps (while) type loops from crashing when encountering an empty list

 


(setq l '(1 2 3 4))

(while l 

  (princ (strcat "\n" (itoa (car l)))

  (setq l (cdr l))

 

 

Some languages define nil as simply not T

 

-David

Share this post


Link to post
Share on other sites
BIGAL

I use the (setq lst '()) to reset it in routines where repeat/while etc are involved probably not needed in code example above. I have not had problems using, if setting to nil is better happy to take that advice.

Share this post


Link to post
Share on other sites

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
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  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.


×
×
  • Create New...