Construction line automatically created when intersecting with specific type of line

[jason_a]

This is what i'm currently doing.

 

I draw a line at a 45 degree angle and put it on it's own layer (lets call it "45"). I then create a vertical construction line which intersects the 45 degree angle line. (When I create the vertical construction line, I don't select the 45 degree angle line as a point. The point is anywhere other than on the 45.) Lastly, I create a horizontal construction line at the point where the vertical line and 45 degree angled line eventually intersect. These lines i'm creating are for quickly double checking my drawing layouts via orthographic projection.

 

What i'm trying to accomplish via lisp is a routine that prompts for an input point to create a vertical construction line. When the vertical construction line is then created and intersects with the line labelled 45, I want a horizontal construction line to be automatically created at that point. The vertical construction line may intersect with other lines within the drawing, but a horizontal construction line should only be created when it detects an intersect with that specific line labelled 45. Is this possible?

 

Thank you.

Edited July 7, 2016 by jason_a

[marko_ribar]

Untested...

 

(defun c:xlion45-V ( / *error* ucsf p xli ss el pp )

 (vl-load-com)

 (defun *error* ( m )
   (if (eq el (entlast))
     (entdel xli)
   )
   (if ucsf
     (command "_.UCS" "_P")
   )
   (if m
     (prompt m)
   )
   (princ)
 )

 (if (= 0 (getvar 'worlducs))
   (progn
     (command "_.UCS" "_W")
     (setq ucsf t)
   )
 )
 (setq p (getpoint "\nPick or specify point : "))
 (setq xli
   (entmakex
     (list
       '(0 . "XLINE")
       '(100 . "AcDbEntity")
       '(100 . "AcDbXline")
       (cons 10 p)
       '(11 0.0 1.0 0.0)
     )
   )
 )
 (setq ss (ssget "_A" '((0 . "LINE") (8 . "45"))))
 (setq el (entlast))
 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
   (if (setq pp (vlax-invoke (vlax-ename->vla-object xli) 'intersectwith (vlax-ename->vla-object e) acextendnone))
     (entmake
       (list
         '(0 . "XLINE")
         '(100 . "AcDbEntity")
         '(100 . "AcDbXline")
         (cons 10 pp)
         '(11 1.0 0.0 0.0)
       )
     )
   )
 )
 (*error* nil)
)

(defun c:xlion45-H ( / *error* ucsf p xli ss el pp )

 (vl-load-com)

 (defun *error* ( m )
   (if (eq el (entlast))
     (entdel xli)
   )
   (if ucsf
     (command "_.UCS" "_P")
   )
   (if m
     (prompt m)
   )
   (princ)
 )

 (if (= 0 (getvar 'worlducs))
   (progn
     (command "_.UCS" "_W")
     (setq ucsf t)
   )
 )
 (setq p (getpoint "\nPick or specify point : "))
 (setq xli
   (entmakex
     (list
       '(0 . "XLINE")
       '(100 . "AcDbEntity")
       '(100 . "AcDbXline")
       (cons 10 p)
       '(11 1.0 0.0 0.0)
     )
   )
 )
 (setq ss (ssget "_A" '((0 . "LINE") (8 . "45"))))
 (setq el (entlast))
 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
   (if (setq pp (vlax-invoke (vlax-ename->vla-object xli) 'intersectwith (vlax-ename->vla-object e) acextendnone))
     (entmake
       (list
         '(0 . "XLINE")
         '(100 . "AcDbEntity")
         '(100 . "AcDbXline")
         (cons 10 pp)
         '(11 0.0 1.0 0.0)
       )
     )
   )
 )
 (*error* nil)
)

Regards...

Edited July 7, 2016 by marko_ribar
added error handler and both versions V/H xlines

[pkenewell]

My Version - quickly put together and only for LINE objects:

 

 

(defun c:test (/ doc space en el ep1 ep2 vp1 vp2 inp)
  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object))
        space (if (> (getvar "CVPORT") 1)(vla-get-modelspace doc)(vla-get-paperspace doc))
  )
  (if (setq en(entsel "\nSelect a Line: "))
     (progn
        (setq el  (entget (car en))
              ep1 (cdr (assoc 10 el))
              ep2 (cdr (assoc 11 el))
        )
        (if (setq vp1 (getpoint "\nSelect a point for a vertical xline: ")
                  vp2 (polar vp1 (/ pi 2) 1.0)
                  inp (inters ep1 ep2 vp1 vp2 nil)
            )
           (progn
              (vla-addxline space (vlax-3d-point vp1)(vlax-3d-point vp2))
              (vla-addxline space (vlax-3d-point inp)(vlax-3d-point (polar inp 0.0 1.0)))
           )
        )
     )
  )
)

[jason_a]

Thank you so much! I will be reviewing them shortly, it's much appreciated!

[jason_a]

I've tried both routines and the first one appears to work a little more seamlessly. Once again thank you for both your input.

 

My next question is in regards to the first routine, how would I modify it to work in the reverse. Ie, as I create a horizontal construction line, I then get a vertical construction line at the intersection?

[MaxwellEdison]

Presumptuous question about your workflow. It seems from your request you're looking to create an automatic miter line for orthographic projections. If this is the case, Is there a benefit I am missing over creating a reference copy of the top view rotated 90 degrees above the side view instead?

[pkenewell]

Here's a couple to try. The first one is the same as previous post except I am checking to make sure the selected object is a line. Both have been tested.

 

 

(defun c:XL-INT-V (/ doc space en el ep1 ep2 vp1 vp2 inp)
  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object))
        space (if (> (getvar "CVPORT") 1)(vla-get-modelspace doc)(vla-get-paperspace doc))
  )
  (if (and
         (setq en (entsel "\nSelect a Line: "))
         (= (cdr (assoc 0 (setq el (entget (car en))))) "LINE")
      )
     (progn
        (setq ep1 (cdr (assoc 10 el))
              ep2 (cdr (assoc 11 el))
        )
        (if (setq vp1 (getpoint "\nSelect a point for a vertical xline: ")
                  vp2 (polar vp1 (/ pi 2) 1.0)
                  inp (inters ep1 ep2 vp1 vp2 nil)
            )
           (progn
              (vla-addxline space (vlax-3d-point vp1)(vlax-3d-point vp2))
              (vla-addxline space (vlax-3d-point inp)(vlax-3d-point (polar inp 0.0 1.0)))
           )
        )
     )
  )
)
(defun c:XL-INT-H (/ doc space en el ep1 ep2 vp1 vp2 inp)
  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object))
        space (if (> (getvar "CVPORT") 1)(vla-get-modelspace doc)(vla-get-paperspace doc))
  )
  (if (and
         (setq en (entsel "\nSelect a Line: "))
         (= (cdr (assoc 0 (setq el (entget (car en))))) "LINE")
      )
     (progn
        (setq ep1 (cdr (assoc 10 el))
              ep2 (cdr (assoc 11 el))
        )
        (if (setq vp1 (getpoint "\nSelect a point for a Horizontal xline: ")
                  vp2 (polar vp1 0.0 1.0)
                  inp (inters ep1 ep2 vp1 vp2 nil)
            )
           (progn
              (vla-addxline space (vlax-3d-point vp1)(vlax-3d-point vp2))
              (vla-addxline space (vlax-3d-point inp)(vlax-3d-point (polar inp (/ pi 2) 1.0)))
           )
        )
     )
  )
)

 

 

EDIT: Please note: I am not trying to give you a fully wrought solution but simply to show you how to do what you need. This program has no error handling. I expect that you would adapt this into your own routine once you have the knowledge.

[jason_a]

Presumptuous question about your workflow. It seems from your request you're looking to create an automatic miter line for orthographic projections. If this is the case, Is there a benefit I am missing over creating a reference copy of the top view rotated 90 degrees above the side view instead?

 

Yes that is how I used to do it, but i've been recently introduced to this alternative and I find my workflow is much quicker when doing it this way.

[jason_a]

Here's a couple to try. The first one is the same as previous post except I am checking to make sure the selected object is a line. Both have been tested.

 

 

(defun c:XL-INT-V (/ doc space en el ep1 ep2 vp1 vp2 inp)
  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object))
        space (if (> (getvar "CVPORT") 1)(vla-get-modelspace doc)(vla-get-paperspace doc))
  )
  (if (and
         (setq en (entsel "\nSelect a Line: "))
         (= (cdr (assoc 0 (setq el (entget (car en))))) "LINE")
      )
     (progn
        (setq ep1 (cdr (assoc 10 el))
              ep2 (cdr (assoc 11 el))
        )
        (if (setq vp1 (getpoint "\nSelect a point for a vertical xline: ")
                  vp2 (polar vp1 (/ pi 2) 1.0)
                  inp (inters ep1 ep2 vp1 vp2 nil)
            )
           (progn
              (vla-addxline space (vlax-3d-point vp1)(vlax-3d-point vp2))
              (vla-addxline space (vlax-3d-point inp)(vlax-3d-point (polar inp 0.0 1.0)))
           )
        )
     )
  )
)
(defun c:XL-INT-H (/ doc space en el ep1 ep2 vp1 vp2 inp)
  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object))
        space (if (> (getvar "CVPORT") 1)(vla-get-modelspace doc)(vla-get-paperspace doc))
  )
  (if (and
         (setq en (entsel "\nSelect a Line: "))
         (= (cdr (assoc 0 (setq el (entget (car en))))) "LINE")
      )
     (progn
        (setq ep1 (cdr (assoc 10 el))
              ep2 (cdr (assoc 11 el))
        )
        (if (setq vp1 (getpoint "\nSelect a point for a Horizontal xline: ")
                  vp2 (polar vp1 0.0 1.0)
                  inp (inters ep1 ep2 vp1 vp2 nil)
            )
           (progn
              (vla-addxline space (vlax-3d-point vp1)(vlax-3d-point vp2))
              (vla-addxline space (vlax-3d-point inp)(vlax-3d-point (polar inp (/ pi 2) 1.0)))
           )
        )
     )
  )
)

 

 

EDIT: Please note: I am not trying to give you a fully wrought solution but simply to show you how to do what you need. This program has no error handling. I expect that you would adapt this into your own routine once you have the knowledge.

 

Thanks! I'll give it a go.

[jason_a]

Untested...

 

(defun c:xlion45-V ( / *error* ucsf p xli ss el pp )

 (vl-load-com)

 (defun *error* ( m )
   (if (eq el (entlast))
     (entdel xli)
   )
   (if ucsf
     (command "_.UCS" "_P")
   )
   (if m
     (prompt m)
   )
   (princ)
 )

 (if (= 0 (getvar 'worlducs))
   (progn
     (command "_.UCS" "_W")
     (setq ucsf t)
   )
 )
 (setq p (getpoint "\nPick or specify point : "))
 (setq xli
   (entmakex
     (list
       '(0 . "XLINE")
       '(100 . "AcDbEntity")
       '(100 . "AcDbXline")
       (cons 10 p)
       '(11 0.0 1.0 0.0)
     )
   )
 )
 (setq ss (ssget "_A" '((0 . "LINE") (8 . "45"))))
 (setq el (entlast))
 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
   (if (setq pp (vlax-invoke (vlax-ename->vla-object xli) 'intersectwith (vlax-ename->vla-object e) acextendnone))
     (entmake
       (list
         '(0 . "XLINE")
         '(100 . "AcDbEntity")
         '(100 . "AcDbXline")
         (cons 10 pp)
         '(11 1.0 0.0 0.0)
       )
     )
   )
 )
 (*error* nil)
)

(defun c:xlion45-H ( / *error* ucsf p xli ss el pp )

 (vl-load-com)

 (defun *error* ( m )
   (if (eq el (entlast))
     (entdel xli)
   )
   (if ucsf
     (command "_.UCS" "_P")
   )
   (if m
     (prompt m)
   )
   (princ)
 )

 (if (= 0 (getvar 'worlducs))
   (progn
     (command "_.UCS" "_W")
     (setq ucsf t)
   )
 )
 (setq p (getpoint "\nPick or specify point : "))
 (setq xli
   (entmakex
     (list
       '(0 . "XLINE")
       '(100 . "AcDbEntity")
       '(100 . "AcDbXline")
       (cons 10 p)
       '(11 1.0 0.0 0.0)
     )
   )
 )
 (setq ss (ssget "_A" '((0 . "LINE") (8 . "45"))))
 (setq el (entlast))
 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
   (if (setq pp (vlax-invoke (vlax-ename->vla-object xli) 'intersectwith (vlax-ename->vla-object e) acextendnone))
     (entmake
       (list
         '(0 . "XLINE")
         '(100 . "AcDbEntity")
         '(100 . "AcDbXline")
         (cons 10 pp)
         '(11 0.0 1.0 0.0)
       )
     )
   )
 )
 (*error* nil)
)

Regards...

 

Excellent, thank you they both work great!

[MaxwellEdison]

Something about this has been tickling the problem solving part of my brain and I think I figured out what it is. Instead of creating a routine to aid your eye in checking the accuracy of orthographic drawings, why not save a step and have the routine do the checking? As usual, I don't speak code so feel free to ignore me if any of this seems impractical or unwieldy. Heck, it could even be an existing command. I just need to jot it down someplace to stop it from knocking round my head and figured someone may get some benefit from my rambling.

 

Have the user select the linework of each view individually and store the coordinates of line endpoints, arc end and midpoints, and circle quadrants. Compare the groups of points against each other. I.e. Check the Y-values of the Front and side views. For any point that does not have at least one match, change the color of the corresponding linework to flag it.

 

Checking across the miter line is basically the same concept. First create a reference point with the lowest Y-value of the Top view and lowest X-value of the side (X1,Y1) and check that each point has a match in terms of distance from that reference point (X2-X1=Y2-Y1).

[jason_a]

That would be brilliant if something like that could be coded. Unfortunately I don't have enough lisp experience to even know where to begin with coding that type of routine. One concern I have though is in the case of a line finding a theoretical match but it's not actually related to the entity. It's essentially a false positive. A quick glance with all the flagged colours would give one the impression everything is good to go, but upon further inspection this would not be the case.

[jason_a]

Untested...

 

(defun c:xlion45-V ( / *error* ucsf p xli ss el pp )

 (vl-load-com)

 (defun *error* ( m )
   (if (eq el (entlast))
     (entdel xli)
   )
   (if ucsf
     (command "_.UCS" "_P")
   )
   (if m
     (prompt m)
   )
   (princ)
 )

 (if (= 0 (getvar 'worlducs))
   (progn
     (command "_.UCS" "_W")
     (setq ucsf t)
   )
 )
 (setq p (getpoint "\nPick or specify point : "))
 (setq xli
   (entmakex
     (list
       '(0 . "XLINE")
       '(100 . "AcDbEntity")
       '(100 . "AcDbXline")
       (cons 10 p)
       '(11 0.0 1.0 0.0)
     )
   )
 )
 (setq ss (ssget "_A" '((0 . "LINE") (8 . "45"))))
 (setq el (entlast))
 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
   (if (setq pp (vlax-invoke (vlax-ename->vla-object xli) 'intersectwith (vlax-ename->vla-object e) acextendnone))
     (entmake
       (list
         '(0 . "XLINE")
         '(100 . "AcDbEntity")
         '(100 . "AcDbXline")
         (cons 10 pp)
         '(11 1.0 0.0 0.0)
       )
     )
   )
 )
 (*error* nil)
)

(defun c:xlion45-H ( / *error* ucsf p xli ss el pp )

 (vl-load-com)

 (defun *error* ( m )
   (if (eq el (entlast))
     (entdel xli)
   )
   (if ucsf
     (command "_.UCS" "_P")
   )
   (if m
     (prompt m)
   )
   (princ)
 )

 (if (= 0 (getvar 'worlducs))
   (progn
     (command "_.UCS" "_W")
     (setq ucsf t)
   )
 )
 (setq p (getpoint "\nPick or specify point : "))
 (setq xli
   (entmakex
     (list
       '(0 . "XLINE")
       '(100 . "AcDbEntity")
       '(100 . "AcDbXline")
       (cons 10 p)
       '(11 1.0 0.0 0.0)
     )
   )
 )
 (setq ss (ssget "_A" '((0 . "LINE") (8 . "45"))))
 (setq el (entlast))
 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
   (if (setq pp (vlax-invoke (vlax-ename->vla-object xli) 'intersectwith (vlax-ename->vla-object e) acextendnone))
     (entmake
       (list
         '(0 . "XLINE")
         '(100 . "AcDbEntity")
         '(100 . "AcDbXline")
         (cons 10 pp)
         '(11 0.0 1.0 0.0)
       )
     )
   )
 )
 (*error* nil)
)

Regards...

 

 

This is working brilliantly and has reduced my work time! Thanks!

 

I do have an additional request if possible though. It currently creates a construction line only if it detects the 45 degree mitre line within its path. If I click anywhere on screen where it does not detect a possible intersect with the mitred line , it will not create a construction line at all. So is it possible for it to work as it does right now AND to create a normal construction line when it does not detect the mitre line within its path? Something like an 'OR' function? Thanks.

[marko_ribar]

Sure it's possible :

change :

(if (setq pp (vlax-invoke (vlax-ename->vla-object xli) 'intersectwith (vlax-ename->vla-object e) acextendnone))

to :

(if (setq pp (vlax-invoke (vlax-ename->vla-object xli) 'intersectwith (vlax-ename->vla-object e) acextendotherentity))

 

Changes should be applied to both lisps if you wish them to operate that way...

Regards...