Begin line at block insertion point

[stevesfr]

(defun c:AtInsert3 (/ obj)
 (if
   (setq obj
          (SelectifFoo
            (lambda (x)
              (if
                (vlax-property-available-p
                  (setq x (vlax-ename->vla-object x))
                  'InsertionPoint
                )
                 x
              )
            )
            "\nSelect Object: "
          )
   )
    ;; AJT begin edit
    ((lambda (ins)
       (if (eq 1 (logand 1 (getvar 'cmdactive)))
         ins
         (command "_.line" "_non" ins "_non" (c:ATInsert3))
       )
     )
      (trans (vlax-get obj 'InsertionPoint) 0 1)
    )
    ;; AJT end edit
 )
)
(defun SelectifFoo (foo str / sel x)
 (while
   (progn
     (setq sel (entsel str))

     (cond
       (
        (vl-consp sel)

        (if (not (setq x (foo (car sel))))
          (princ "\n** Invalid Object Selected **")
        )
       )
     )
   )
 )
 x
)

 

Of course, if that's all you wanted, this could be a lot simpler.

 

Great... thank you, thank you...

what would it take to repeat the picking of attributes, good until cancel...

like picking point codes (attributes) for edge of road, to next attribute for edge of road, on and on to construct edge of road from many points (or utility lines from poles, etc) Hate to be a gimm-e, but others should love this program also !!

Thanks for efforts, without this site, there surely would be a void.

S

[Lee Mac]

Bear in mind that this:

 

(trans (vlax-get obj 'InsertionPoint) 0 1)

 

Will only work if the UCS XY plane is parallel to the WCS XY plane.

[alanjt]

 

[color=Yellow](defun c:CB (/ _sel lst pt)
 ;; Connect blocks (by insertion point)
 ;; Alan J. Thompson, 05.22.10
 (defun _sel (msg / ent dxf10)
   (setvar 'errno 0)
   (while (and (not ent) (/= 52 (getvar 'errno)))
     (if (setq ent (car (entsel (strcat "\n" msg))))
       (if (setq dxf10 (cdr (assoc 10 (entget ent))))
         dxf10
         (setq ent (prompt "\nInvalid object!"))
       )
       (if (eq 7 (getvar 'errno))
         (princ "\nMissed, try again.")
       )
     )
   )
 )

[/color] [color=Yellow]   (if (car (setq lst (list (_sel "Select block: "))))
   (while (setq pt (_sel "Select next block: "))
     (setq lst (cons pt lst))
     (entmakex (list '(0 . "LINE") (cons 10 (cadr lst)) (cons 11 (car lst))))
   )
 )
 (princ)
)[/color]

 

Code UPDATED, post #27 for ObjectConnect...

[alanjt]

Bear in mind that this:

 

(trans (vlax-get obj 'InsertionPoint) 0 1)

Will only work if the UCS XY plane is parallel to the WCS XY plane.

Rat farts! I just assumed what I copied was your most recent (with trans edit).

[alanjt]

Actually, this makes better sense...

 

(defun c:CB (/ _sel lst pt)
 ;; Connect blocks (by insertion point)
 ;; Alan J. Thompson, 05.22.10
 (vl-load-com)
 (defun _sel (msg / ent)
   (setvar 'errno 0)
   (while (and (not ent) (/= 52 (getvar 'errno)))
     (if (setq ent (car (entsel (strcat "\n" msg))))
       (if (vlax-property-available-p (setq ent (vlax-ename->vla-object ent)) 'InsertionPoint)
         (vlax-get ent 'InsertionPoint)
         (setq ent (prompt "\nInvalid object!"))
       )
       (if (eq 7 (getvar 'errno))
         (princ "\nMissed, try again.")
       )
     )
   )
 )

 (if (car (setq lst (list (_sel "Select block: "))))
   (while (setq pt (_sel "Select next block: "))
     (setq lst (cons pt lst))
     (entmakex (list '(0 . "LINE") (cons 10 (cadr lst)) (cons 11 (car lst))))
   )
 )
 (princ)
)

[stevesfr]

 

(defun c:CB (/ _sel lst pt)
 ;; Connect blocks (by insertion point)
 ;; Alan J. Thompson, 05.22.10
 (defun _sel (msg / ent dxf10)
   (setvar 'errno 0)
   (while (and (not ent) (/= 52 (getvar 'errno)))
     (if (setq ent (car (entsel (strcat "\n" msg))))
       (if (setq dxf10 (cdr (assoc 10 (entget ent))))
         dxf10
         (setq ent (prompt "\nInvalid object!"))
       )
       (if (eq 7 (getvar 'errno))
         (princ "\nMissed, try again.")
       )
     )
   )
 )

 (if (car (setq lst (list (_sel "Select block: "))))
   (while (setq pt (_sel "Select next block: "))
     (setq lst (cons pt lst))
     (entmakex (list '(0 . "LINE") (cons 10 (cadr lst)) (cons 11 (car lst))))
   )
 )
 (princ)
)

 

Perfect !!!!!!!!!!!! Thanks much !!! Alan suggest you rename this with a catchy phrase and put it in the archive... any 'civil' or surveyor running vanilla ACAD is sure to love this....... no more rename F-key, no more transparent entry, just slam bam......

a very happy weekent to you guys for the help.

S

[alanjt]

Perfect !!!!!!!!!!!! Thanks much !!! Alan suggest you rename this with a catchy phrase and put it in the archive... any 'civil' or surveyor running vanilla ACAD is sure to love this....... no more rename F-key, no more transparent entry, just slam bam......

a very happy weekent to you guys for the help.

S

 

Know that the first one will use the dxf 10 code of the object (almost all objects have one). Whereas, the second is a bit more selective and using what Lee proposed with only accepting objects that have an InsertionPoint.

 

I guess it should really be called Object Connect...

 

(defun c:OC (/ _sel lst pt)
 ;; Connect objects (by insertion point)
 ;; Alan J. Thompson, 05.22.10
 (defun _sel (msg / ent dxf10)
   (setvar 'errno 0)
   (while (and (not ent) (/= 52 (getvar 'errno)))
     (if (setq ent (car (entsel (strcat "\n" msg))))
       (if (setq dxf10 (cdr (assoc 10 (entget ent))))
         dxf10
         (setq ent (prompt "\nInvalid object!"))
       )
       (if (eq 7 (getvar 'errno))
         (princ "\nMissed, try again.")
       )
     )
   )
 )

 (if (car (setq lst (list (_sel "Select object: "))))
   (while (setq pt (_sel "Select next object: "))
     (setq lst (cons pt lst))
     (entmakex (list '(0 . "LINE") (cons 10 (cadr lst)) (cons 11 (car lst))))
   )
 )
 (princ)
)

[alanjt]

Oh yeah; you're welcome and enjoy.

 

Food for thought: Next time, give ALL information up front. If you had stated EXACTLY what you wanted, Lee would have taken care of you from the start. His submissions worked perfectly, based on the information he was provided.

[stevesfr]

Know that the first one will use the dxf 10 code of the object (almost all objects have one). Whereas, the second is a bit more selective and using what Lee proposed with only accepting objects that have an InsertionPoint.

 

I guess it should really be called Object Connect...

 

(defun c:OC (/ _sel lst pt)
 ;; Connect objects (by insertion point)
 ;; Alan J. Thompson, 05.22.10
 (defun _sel (msg / ent dxf10)
   (setvar 'errno 0)
   (while (and (not ent) (/= 52 (getvar 'errno)))
     (if (setq ent (car (entsel (strcat "\n" msg))))
       (if (setq dxf10 (cdr (assoc 10 (entget ent))))
         dxf10
         (setq ent (prompt "\nInvalid object!"))
       )
       (if (eq 7 (getvar 'errno))
         (princ "\nMissed, try again.")
       )
     )
   )
 )

 (if (car (setq lst (list (_sel "Select object: "))))
   (while (setq pt (_sel "Select next object: "))
     (setq lst (cons pt lst))
     (entmakex (list '(0 . "LINE") (cons 10 (cadr lst)) (cons 11 (car lst))))
   )
 )
 (princ)
)

 

 

Understood; again many thanks for spending time on this.

S

[alanjt]

Just for fun, here's one more...

 

(defun c:OC (/ _sel AT:DrawX lst pt)
 ;; Connect objects (by insertion point)
 ;; Alan J. Thompson, 05.22.10
 (defun _sel (msg / ent dxf10)
   (setvar 'errno 0)
   (while (and (not ent) (/= 52 (getvar 'errno)))
     (if (setq ent (car (entsel (strcat "\n" msg))))
       (if (setq dxf10 (cdr (assoc 10 (entget ent))))
         dxf10
         (setq ent (prompt "\nInvalid object!"))
       )
       (if (eq 7 (getvar 'errno))
         (princ "\nMissed, try again.")
       )
     )
   )
 )

 (defun AT:DrawX (P C / d n)
   ;; Draw and "X" vector at specified point
   ;; P - Placement point for "X"
   ;; C - Color of "X" (must be integer b/w 1 & 255)
   ;; Alan J. Thompson, 10.31.09
   (if (and (vl-consp P) (setq d (* (getvar "VIEWSIZE") 0.02)))
     (progn (grvecs (cons C
                          (mapcar
                            (function (lambda (#) (trans (polar P (* # pi) d) 0 1)))
                            '(0.25 1.25 0.75 1.75)
                          )
                    )
            )
            P
     )
   )
 )

 (redraw)
 (if (car (setq lst (list (AT:DrawX (_sel "Select object: ") 1))))
   (while (setq pt (_sel "Select next object: "))
     (redraw)
     (setq lst (cons pt lst))
     (entmakex (list '(0 . "LINE") (cons 10 (cadr lst)) (cons 11 (AT:DrawX (car lst) 1))))
   )
 )
 (redraw)
 (princ)
)

Off to mow, later guys.

[alanjt]

Here's one that will display a connecting line from last selected object to cursor.

 

(defun c:OC (/ _sel lst pt)
 ;; Connect objects (by insertion point)
 ;; Alan J. Thompson, 05.22.10
 (vl-load-com)
 (defun _sel (pnt msg / gr ss pt)
   (while (and (setq gr (grread T 15 2))
               (/= (car gr) 25)
               (not (vl-position (cadr gr) '(13 158)))
               (not ss)
          )
     (redraw)
     (and pnt (grdraw (trans pnt 0 1) (cadr gr) 1 -1))
     (princ (strcat "\r" msg))
     (if (and (eq 3 (car gr))
              (setq ss (ssget (cadr gr)))
              (setq pt (cdr (assoc 10 (entget (ssname ss 0)))))
         )
       pt
     )
   )
 )

 (if (car (setq lst (list (_sel nil "Select object: "))))
   (while (setq pt (_sel (car lst) "Select next object: "))
     (if (equal pt (car lst))
       (alert "Same object as previous!")
       (progn (setq lst (cons pt lst))
              (entmakex (list '(0 . "LINE") (cons 10 (cadr lst)) (cons 11 (car lst))))
       )
     )
   )
 )
 (redraw)
 (princ)
)

 

 

 

I don't know what's going on Camtasia. Lee, what settings do you use?

[alanjt]

While this has been fun to write, you could just set you running OSnap to only use Insertion, execute the line/pline command and connect away. If you're only wanting to connect blocks and a few other objects.

[alanjt]

Last one.

 

This will ignore arcs and anything with the word line in it.

 

(defun c:OC (/ _sel lst pt)
 ;; Connect objects (by insertion point)
 ;; Alan J. Thompson, 05.22.10
 (vl-load-com)
 (defun _sel (pnt msg / gr e pt)
   (while (and (setq gr (grread T 15 2))
               (/= (car gr) 25)
               (not (vl-position (cadr gr) '(13 158)))
               (not e)
          )
     (redraw)
     (and pnt (grdraw (trans pnt 0 1) (cadr gr) 1 -1))
     (princ (strcat "\r" msg))
     (if (and (eq 3 (car gr))
              (setq e (ssget (cadr gr)))
              (setq e (entget (ssname e 0)))
              (not (wcmatch (cdr (assoc 0 e)) "*LINE*,ARC"))
              (setq pt (cdr (assoc 10 e)))
         )
       pt
       (setq e nil)
     )
   )
 )

 (if (car (setq lst (list (_sel nil "Select object: "))))
   (while (setq pt (_sel (car lst) "Select next object: "))
     (if (equal pt (car lst))
       (alert "Same object as previous!")
       (progn (setq lst (cons pt lst))
              (entmakex (list '(0 . "LINE") (cons 10 (cadr lst)) (cons 11 (car lst))))
       )
     )
   )
 )
 (redraw)
 (princ)
)

[stevesfr]

While this has been fun to write, you could just set you running OSnap to only use Insertion, execute the line/pline command and connect away. If you're only wanting to connect blocks and a few other objects.

 

With all respect Alan:

For the intended purpose of this exercise, use of running OSnap via Insertion is useless. Look at the attached dwg and using OSnap ins try to connect all the blocks having an attribute of "B4SW" which stands for Back of 4 ft sidewalk. Then try one of the best programs written for this exercise. Is one trial impossible, you bet.

So you can see the value of the work done by you two today !!

Cheers,

S

atinsert.dwg

[alanjt]

Ahh, OK, then you could use NODE. :wink: Did you get a look at the one posted with the above video?

 

 

 

I fear the consequences of releasing this (sorts blocks based on point number - a major tweak on one I wrote for Civil 3D points)...

 

 

 

My Camtasia has gone completely bonkers.

[stevesfr]

Ahh, OK, then you could use NODE. :wink: Did you get a look at the one posted with the above video?

 

 

 

I fear the consequences of releasing this (sorts blocks based on point number - a major tweak on one I wrote for Civil 3D points)...

 

[ATTACH]20156[/ATTACH]

 

 

My Camtasia has gone completely bonkers.

 

Alan:

Ha ha, anybody can find the NODE when its outstanding by itself and as plain as the nose on your face. But try and find the NODES for some of the B4SW in the dwg I previously attached, impossible. I've often had it so cluttered I couldn't even read the attributes. Got to have OC.lsp in my toolbox.

Cheers

S

[SEANT]

It looks like the OP’s request has met with great success. Nice work Alan, Lee.

 

My decision to make a Lisp related comment was probably ill advised. The intention, however, was to relate the setup to my own ActiveX experience (VBA), and the various translations required to derive useful coordinates.

 

 

Bear in mind that this:

 

(trans (vlax-get obj 'InsertionPoint) 0 1)

 

Will only work if the UCS XY plane is parallel to the WCS XY plane.

 

It does seem like the “command” function respects the current UCS when evaluating coordinates. If the InsertionPoint is expressed in the WCS, wouldn’t this always work?

 

(command "_.line" "_non"(trans (vlax-get obj 'InsertionPoint) 0 1))

 

 

 

 

 

 

   (trans (vlax-get obj 'InsertionPoint) (vlax-get obj 'Normal) 1)

 

Actually, that line above doesn’t strike a chord with any of my ActiveX experience. How would this play out in the line creation scenario?

[Lee Mac]

Upon further testing it seems you are corrent Sean, when using command, then current UCS is considered.

 

Only that in my experience, when retrieving entity coordinates, the plane in which the entity resides must be considered when transforming the coordinates - this plane may be different from both WCS and UCS.

[alanjt]

Alan:

Ha ha, anybody can find the NODE when its outstanding by itself and as plain as the nose on your face. But try and find the NODES for some of the B4SW in the dwg I previously attached, impossible. I've often had it so cluttered I couldn't even read the attributes. Got to have OC.lsp in my toolbox.

Cheers

S

Believe me, I feel and know your pain. I did (and still do some) survey work when I first started in CAD and it was a lot of 'dot connecting'. Hell, I'll be adding to to my own toolbox come Monday.

 

Out of curiosity, which OC version did you take? Did you see the last video I posted (where it connects everything matching selected object's description?

[alanjt]

Thanks Sean.

 

 

Lee, what are your settings for Camtasia?