Inserting Property Connections in a Subdivision plan

[laijumalias]

 

Hi All, 

 

First of all thanks for LeeMac for the free code which I tried to modify to suit

 

I am a beginner in LISP.

 

The situation is to place a property connection block for each property boundary in perpendicular to the service line at a specific distance from intersecting point, The yellow line in the image is prop boundary and red continues is the service main line and magenta lines are the property connections, what I am trying to do is automate the placement of the magenta blocks one for left and the other for right (i.e. if the property line directly intersect the service line "Left" block will inset and when the property line extension intersect the service line "Right" block to insert. The insertion point is 1.2m away from the intersection and there should be at least 0.5m gap between left and right property connections. 

 

I was Trying to use the code by LeeMac by modifying it to insert a block in all the intersection of a line crossing with another as follows. But it always places the block in co-ordinates as per WCS. In all the portions added by me I have inserted a comment what I am expecting the code to do. 

 

When ever I run the following code the blocks are placed some where in space, if the UCS is not WCS. It would be good if it can run along the Service polyline changing the UCS direction in one click rather tan selecting each segment one by one for block placement.

 

Thank you all in advance.

 

 

 

 

;; Intersections Between Sets  -  Lee Mac
;; Returns a list of all points of intersection between objects in two selection sets.
;; ss1,ss2 - [sel] Selection sets

(defun LM:intersectionsbetweensets ( ss1 ss2 / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength ss1))
        (setq ob1 (vlax-ename->vla-object (ssname ss1 (setq id1 (1- id1)))))
        (repeat (setq id2 (sslength ss2))
            (setq ob2 (vlax-ename->vla-object (ssname ss2 (setq id2 (1- id2))))
                  rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
            )
        )
    )
    (apply 'append (reverse rtn))
)
(defun c:xs ( / ss1 ss2 )
(setq uob (entsel "\n Select object for ucs :")) ; request for Object selection to set UCS       
(command "ucs" "ob" uob) ; Set the UCS to the Object in the previos selection
    (if (and (setq ss1 (ssget))
             (setq ss2 (ssget))
        )
        (foreach pnt (LM:intersectionsbetweensets ss1 ss2)
            (entmake (list '(0 . "POINT") (cons 10 pnt)))
        (trans pnt 0 1 0) ; Convert point from WCS to UCS 
    (command "-insert" "SL" pnt "" "" "") ; Insert block named "SL" at each intersection point
        )
    )
(command "ucs" "p") ; Reset the UCS to previous state
    (princ)
)
(vl-load-com) (princ)

[BIGAL]

It may be simpler to custom rewrite just trying to think about reducing number of picks. I have drawn sewers so know what your doing. 

 

The obvious is need a sample dwg as need to look at linework what is it ?

 

Not sure why your changing UCS all my subdivision plans were done in world. 

Edited June 6, 2021 by BIGAL

[laijumalias]

Thank you BIGAL for your quick response. Please find drawing file attached for reference as requested, I tried to change the UCS every time so when inserting the block i thought it will be perpendicular to the Main service Line. What I am expecting is to pick the service line first and then select all the property lines next, it should do the work.

 

Actually I don't want to change the UCS if the work can be done with out changing it.

 

Thanks in advance.

sewer PB.dwg

Edited June 6, 2021 by laijumalias

[laijumalias]

Thank you BIGAL for your quick response. Please find drawing file attached for reference as requested, I tried to change the UCS every time so when inserting the block i thought it will be perpendicular to the Main service Line. What I am expecting is to pick the service line first and then select all the property lines next, it should do the work.

 

Actually I don't want to change the UCS if the work can be done with out changing it.

 

Thanks in advance.

Edited June 6, 2021 by laijumalias

[BIGAL]

Try this it uses multi radio buttons for the flip option., it may be possible to work out a upstream answer for a pline direction but for moment this is quicker than manual.

 

 

; House connections 
; By AlanH June 2021

(defun ah:swap ( / d1 d2)
(setq d1 (distance pt1 pt3))
(setq d2 (distance pt2 pt3))
(if (> d1 d2)
  (progn 
    (setq temp pt1)
    (setq pt1 pt2)
    (setq pt2 temp)
  )
)
)

(defun c:housecon ( / off pt1 pt2 pt3 ang obj2 obj dist intpt )

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq oldang (getvar 'aunits))
(setvar 'aunits 3)
(setq oldangdir (getvar 'angdir))
(setvar 'angdir 0)
(setq oldangbase (getvar 'angbase))
(SETVAR 'ANGBASE 0.0)

(if (not AH:Butts)(load "Multi Radio buttons.lsp"))
(if (= but nil)(setq but 1))

(setq offs (getreal "\nEnter offset "))
(setq obj (vlax-ename->vla-object (car  (entsel "Pick sewer line "))))

(while (setq ent (entsel "\nPlease pick boundary line near sewer Enter to Exit "))
(setq pt2 (cdr (assoc 11 (entget (car ent)))))
(setq pt1 (cdr (assoc 10 (entget (car ent)))))
(setq pt3 (cadr ent))
(ah:swap)
(setq obj2 (vlax-ename->vla-object (car ent)))

(setq dir "D")
(setq intpt (vlax-invoke obj2 'intersectWith obj acExtendnone))
(if (= intpt nil)
(setq intpt (vlax-invoke obj2 'intersectWith obj acExtendthisentity) dir "U")
)
(setq ang (angle intpt pt1))
(if (= dir "D")(setq ang (+ ang pi)))

(setq distpt (vlax-curve-getdistatpoint obj intpt))
(setq dist(- distpt offs))
(setq pt2 (vlax-curve-getpointatdist obj dist))
(command "-insert" "PROPERTY INLET_DYN" pt2 1 1  (-  ang (/ pi 2) ))
(setq ans (ah:butts but "v"  '("Flip" "Yes" "No")))
(if (= ans "Yes")
(command "mirror" (entlast) "" pt1 (Polar pt1 ang  10) "Y")
)
)

(setvar 'osmode oldsnap)
(setvar 'aunits oldang)
(setvar 'angdir oldangdir)
(setvar 'angbase oldangbase)

(princ)
)

(c:housecon)

 

Multi radio buttons.lsp

Edited June 9, 2021 by BIGAL

[laijumalias]

Thanks BIGAL,

 

Sorry for the delay in getting back to you.

 

This code works wonders, but I have some suggestions if you have time and possible, I have tested the code without the multi radio button and found out that by changing the Pline direction we can achieve the expected result if the insertion point is upstream or down stream. See the attached result the property connection should be always perpendicular to the Main line regardless of the property boundary some times the property boundary is slanting to the sewer line(see the Green block prop connection is the expected one against the red which is done by LISP), also if we can select the block instead of having the block name in the code, so we can use this same code for sewer as well as water connections, finally instead of selecting the property boundary one by one if we can select all of the at time with fence/window/Crossing window it will be amazing.

 

sewer PB.dwg

[BIGAL]

Will see if can find time, you are right about pline direction easy fix. Say reverse 1st connection then reverse pline so rest are correct.

 

For block name (setq bname (cdr (assoc 2 (entget (car (entsel "\nPick a block")))))) put in code say pick block, pick sewer.

 

and (command bname pt2 1 1 (- ang (/ pi 2) ))

 

Yes can do a fence option, why not have a go ! Will help when you get stuck. 

 

 

[BIGAL]

It needs a is it left or right of sewer line ? problem is in boundary line crossing, so need a bit of reworking will try soon.

[laijumalias]

Thanks for your reply, I will try the fence option and will let you know as well.

Thanks,

Laiju

[laijumalias]

HI BIGAL Sorry I don''t know how to use the fence selection and get the program work in your code. I tried but failed.

 

Any help please

 

[BIGAL]

Sorry forgot about this will have another go at it. Have some time over the next few days.

[laijumalias]

12 hours ago, BIGAL said:

Sorry forgot about this will have another go at it. Have some time over the next few days.

Thanks for considering.

[BIGAL]

Try this you just drag a 2pt line over the yellow boundaries 1 side at a time. Just press "Enter" when finished picking. For your dwg that is like 4 at a time.

 

; House connections 
; By AlanH June 2021

(defun ah:swap ( / d1 d2)

(setq pt3 (vlax-invoke obj3 'intersectWith obj2 acExtendthisentity))
(setq d1 (distance pt1 pt3))
(setq d2 (distance pt2 pt3))
(if (> d1 d2)
  (progn 
    (setq temp pt1)
    (setq pt1 pt2)
    (setq pt2 temp)
  )
)
)

(defun alg-ang (obj pnt)
  (angle '(0. 0. 0.)
     (vlax-curve-getfirstderiv
       obj
       (vlax-curve-getparamatpoint
         obj
         pnt
       )
     )
  )
)
(defun c:housecon ( / off pt1 pt2 pt3 pt4 pt5 ang obj2 obj dist intpt )

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq oldang (getvar 'aunits))
(setvar 'aunits 3)
(setq oldangdir (getvar 'angdir))
(setvar 'angdir 0)
(setq oldangbase (getvar 'angbase))
(SETVAR 'ANGBASE 0.0)

;(if (not AH:Butts)(load "Multi Radio buttons.lsp"))
;(if (= but nil)(setq but 1))

(setq offs (getreal "\nEnter offset "))
(setq obj (vlax-ename->vla-object (car  (entsel "Pick sewer line "))))

(while (setq pt4 (getpoint "\nPick 1st point "))
(setq pt5 (getpoint pt4 "\nPick next point "))
(setq ss (ssget "F" (list pt4 pt5) (list (cons 0 "LINE"))))
(command "line" pt4 pt5 "")
(setq obj3 (vlax-ename->vla-object(entlast)))

(repeat (setq x (sslength ss))
(setq ent (ssname ss (setq x (1- x))))
(setq pt2 (cdr (assoc 11 (entget ent))))
(setq pt1 (cdr (assoc 10 (entget ent))))
(setq obj2 (vlax-ename->vla-object ent))
(ah:swap)

(setq intpt (vlax-invoke obj2 'intersectWith obj acExtendnone))

(if (= intpt nil)
 
  (progn
   (setq dir "D")
    (setq intpt (vlax-curve-getclosestpointto obj pt1))
  )
   (progn
    (setq intpt (vlax-curve-getclosestpointto obj pt1))
    (setq  dir "U")
  )
)

(setq ang (alg-ang obj intpt))
(if (= dir "D")(setq ang (+ ang pi)))

(setq distpt (vlax-curve-getdistatpoint obj intpt))
(setq dist(- distpt offs))
(setq pt2 (vlax-curve-getpointatdist obj dist))
(command "-insert" "PROPERTY INLET_DYN" pt2 1 1  ang)
)
(vla-delete obj3)
)
(setvar 'osmode oldsnap)
(setvar 'aunits oldang)
(setvar 'angdir oldangdir)
(setvar 'angbase oldangbase)

(princ)
)

(c:housecon)

 

Edited July 15, 2021 by BIGAL