Topic: Move segment after new blockposition

[cadplayer]

Hello!

I have a problem with move a segment from a Polyline to a selected position. I want it so that segment get the new position after pickpoint and than should Polyline entmake connections to segment before and after changed segment.

My try ist that:
1) pick a Polyline
2) pick a Block
3) Move block to a own position -> Block moves to the new position
...
4) I want the segment should move to the new position of the block
    (I have no idea how can calculate new start- and endpoint of changed segment)

Code: [Select]


(defun c:foo ( /
;;;       myerror pline block z pt
      )
 
  (setq oldError *error*)
  (setq osm (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq *error* MyError)

   
  (defun myError (msg)
    (setvar "OSMODE" osm)
      (redraw)
    (princ (strcat "\nCancel: " msg))
    (setq *error* oldError)
   )

;  [1]
  (while (not (and (setq obj (entsel "\n Select a Polyline"))
   (= "LWPOLYLINE" (cdr (assoc 0 (entget (setq pline (car  obj))))))
              )
         )
  )
;  [2]
  (while (not (and (setq obj (entsel "\n Select a Block"))
   (if (= "INSERT" (cdr (assoc 0 (entget (setq block (car  obj))))))
     (setq z 1)
     )
      )
)
  )
  (setq pt (cadr (grread t 13)))
  (while
    (= 5 (car (setq pt (grread t 13 0))))
    (redraw)
    (setq pt (cadr pt)
  cp (vlax-curve-getclosestpointto pline pt)
  )
    (grdraw pt cp 1 1)
;  [3]
    (entmod (subst (cons 10 pt) (assoc 10 (entget block)) (entget block)))
    )
  (redraw)

;  [4] here I calculate the segment coordinates start- endpoint
    (if pline
      (progn
(setq p
       (fix
(vlax-curve-getparamatpoint pline
   (vlax-curve-getclosestpointtoprojection pline
     (trans (cadr pt) 1 0)
     '(0.0 0.0 1.0)
     )
   )
        )
   )
           (setq Pt1 (trans (vlax-curve-getpointatparam pline p) 1 0))
           (setq Pt2 (trans (vlax-curve-getpointatparam pline (1+ p)) 1 0))
)
    )
   (if (and pt1 pt2)
     

  (setq *error* oldError )
  (setvar "OSMODE" osm)
  (princ)
  )


[CAB]

 

Code: [Select]

I want the segment should move to the new position of the blockYou need to be more specific.

Post a drawing of the BEFORE and AFTER so we can see what you are trying to do.

[cadplayer]

Thanks for recall...
So I want change two vertex at same time.

[cadplayer]

Two things I need.
1)
intersection-routine which calculate two intersPt from selected Polyline and the helperline parallel to Polylinesegment throw the new blockposition.
2)
Example how I entmode vertex in a Polyline

[reltro]

for the second task:

Code: [Select]

(defun modVertex (polyline nVertex coordinate / ent cVertexes)
   (setq ent (entget polyline))
   (setq cVertexes
      (vl-remove-if-not
         '(lambda (a / )
            (= (car a) 10)
         )
         ent
      )
   )
   
   (entmod
      (subst
         (cons 10 coordinate)
         (nth nVertex cVertexes)
         ent
      )
   )
)

For the first task:
Whats about inters?
1. calc the vector for the segment
2. add it to blocksbasepoint
3. get the previous/next vertex and the start/entvertex of the segment and then (inters ... )
tada

[cadplayer]

Thanks for help!

Code: [Select]

(defun c:foo ( / modVertex myerror
                 oldError
osm ;OSMODE
pt  ;Blockinsrt point
pline ;PolylineEntity
ang ;Angle from moving segment
Pt1 Pt2 ;Segment before moving segment
Pt3 Pt4 ;Segment after moving segment
p ;Segment number integer
cp; controllpoint along the Polyline
                                              block
                                              z
      )

  (defun modVertex (polyline nVertex coordinate / ent cVertexes)
   (setq ent (entget polyline))
   (setq cVertexes
      (vl-remove-if-not
         '(lambda (a / )
            (= (car a) 10)
         )
         ent
      )
   )
   
   (entmod
      (subst
         (cons 10 coordinate)
         (nth nVertex cVertexes)
         ent
      )
   )
  )

 
  (setq oldError *error*)
  (setq osm (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq *error* MyError)

   
  (defun myError (msg)
    (setvar "OSMODE" osm)
      (redraw)
    (princ (strcat "\nCancel: " msg))
    (setq *error* oldError)
   )


  (while (not (and (setq obj (entsel "\n Select a Polyline"))
   (= "LWPOLYLINE" (cdr (assoc 0 (entget (setq pline (car  obj))))))
              )
         )
  )
  (while (not (and (setq obj (entsel "\n Select a Block"))
   (if (= "INSERT" (cdr (assoc 0 (entget (setq block (car  obj))))))
     (setq z 1)
     )
      )
)
  )
  (setq pt (cadr (grread t 13)))
  (while
    (= 5 (car (setq pt (grread t 13 0))))
    (redraw)
    (setq pt (cadr pt)
  cp (vlax-curve-getclosestpointto pline pt)
  )
    (grdraw pt cp 1 1)
    (entmod (subst (cons 10 pt) (assoc 10 (entget block)) (entget block)))
    )
  (redraw)
    (if pline
      (progn
(setq p
       (fix
(vlax-curve-getparamatpoint pline
   (vlax-curve-getclosestpointtoprojection pline
     (trans (cadr pt) 1 0)
     '(0.0 0.0 1.0)
     )
   )
        )
)

; looking for especially segment from Polyline
; 1. segment Pt1-Pt2
(setq Pt1 (trans (vlax-curve-getpointatparam pline (if (minusp (1- p))
(progn
   (princ "\n Missing segment before")
   (exit)
   )
(1- p)
           )
   )
1 0
           )
)
        (if (setq Pt2 (trans (vlax-curve-getpointatparam pline p) 1 0))
  pt2
  (princ "\n No 2. segment")
)
; 2. segment Pt2-Pt3, segment should move to new position
(if (setq Pt3 (trans (vlax-curve-getpointatparam pline (1+ p)) 1 0))
  pt3
  (princ "\n No 3. segment")
)
; 3. segment Pt3-Pt4
(setq Pt4 (trans (if (vlax-curve-getpointatparam pline (+ 2 p))
   (vlax-curve-getpointatparam pline (+ 2 p))
   (progn
     (princ "\n Missing segment after")
     (exit)
    )
   )
1 0)
)
)
       )
   
   (if (= "" (getstring "\n Do you want move segm.?"))
     (progn
       ; Calculate angle from segment
       (setq ang
      (angle '(0 0 0) (vlax-curve-getFirstDeriv pline (vlax-curve-getParamAtPoint pline cp))
              )
      )
       ; Move first vertex from segment
       (modVertex pline p (inters pt1 (polar pt1 (angle pt1 pt2) 100)
  (polar (cadr pt) ang 100)
  (polar (cadr pt) ang -100)
          )
       )
       (modVertex pline (1+ p) (inters pt4 (polar pt4 (angle pt4 pt3) 100)
       (polar (cadr pt) ang 100)
       (polar (cadr pt) ang -100)
       )
        )
       )
     )
  (setq *error* oldError )
  (setvar "OSMODE" osm)
  (princ)
  )
What are you thinking about my work?
Another question, is it possible to build a reactor which move segment automatically after moving blockposition?

[CAB]

For a reactor example see this fine routine.    http://lee-mac.com/assoctextbox.html

[reltro]

nice one cadplayer...

I tested it, but it does not work...
-> ; error: bad DXF group: (10)

but, found the error

I added a nil at the end of the (inters ....).
like: (inter P1 P2 P3 P4 nil)

have a look at:
http://docs.autodesk.com/ACD/2013/ENU/index.html?url=files/GUID-A181D474-F817-4550-86E9-87649262FA8A.htm,topicNumber=d30e620107

Code: [Select]

;; source [cadplayer]
;; modified inters[reltro]

(defun c:foo ( / modVertex myerror
                 oldError
osm ;OSMODE
pt  ;Blockinsrt point
pline ;PolylineEntity
ang ;Angle from moving segment
Pt1 Pt2 ;Segment before moving segment
Pt3 Pt4 ;Segment after moving segment
p ;Segment number integer
cp; controllpoint along the Polyline
                                              block
                                              z
      )

  (defun modVertex (polyline nVertex coordinate / ent cVertexes)
   (setq ent (entget polyline))
   (setq cVertexes
      (vl-remove-if-not
         '(lambda (a / )
            (= (car a) 10)
         )
         ent
      )
   )
   
   (entmod
      (subst
         (cons 10 coordinate)
         (nth nVertex cVertexes)
         ent
      )
   )
  )

 
  (setq oldError *error*)
  (setq osm (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq *error* MyError)

   
  (defun myError (msg)
    (setvar "OSMODE" osm)
      (redraw)
    (princ (strcat "\nCancel: " msg))
    (setq *error* oldError)
   )


  (while (not (and (setq obj (entsel "\n Select a Polyline"))
   (= "LWPOLYLINE" (cdr (assoc 0 (entget (setq pline (car  obj))))))
              )
         )
  )
  (while (not (and (setq obj (entsel "\n Select a Block"))
   (if (= "INSERT" (cdr (assoc 0 (entget (setq block (car  obj))))))
     (setq z 1)
     )
      )
)
  )
  (setq pt (cadr (grread t 13)))
  (while
    (= 5 (car (setq pt (grread t 13 0))))
    (redraw)
    (setq pt (cadr pt)
  cp (vlax-curve-getclosestpointto pline pt)
  )
    (grdraw pt cp 1 1)
    (entmod (subst (cons 10 pt) (assoc 10 (entget block)) (entget block)))
    )
  (redraw)
    (if pline
      (progn
(setq p
       (fix
(vlax-curve-getparamatpoint pline
   (vlax-curve-getclosestpointtoprojection pline
     (trans (cadr pt) 1 0)
     '(0.0 0.0 1.0)
     )
   )
        )
)

; looking for especially segment from Polyline
; 1. segment Pt1-Pt2
(setq Pt1 (trans (vlax-curve-getpointatparam pline (if (minusp (1- p))
(progn
   (princ "\n Missing segment before")
   (exit)
   )
(1- p)
           )
   )
1 0
           )
)
        (if (setq Pt2 (trans (vlax-curve-getpointatparam pline p) 1 0))
  pt2
  (princ "\n No 2. segment")
)
; 2. segment Pt2-Pt3, segment should move to new position
(if (setq Pt3 (trans (vlax-curve-getpointatparam pline (1+ p)) 1 0))
  pt3
  (princ "\n No 3. segment")
)
; 3. segment Pt3-Pt4
(setq Pt4 (trans (if (vlax-curve-getpointatparam pline (+ 2 p))
   (vlax-curve-getpointatparam pline (+ 2 p))
   (progn
     (princ "\n Missing segment after")
     (exit)
    )
   )
1 0)
)
)
       )
   
   (if (= "" (getstring "\n Do you want move segm.?"))
     (progn
       ; Calculate angle from segment
       (setq ang
      (angle '(0 0 0) (vlax-curve-getFirstDeriv pline (vlax-curve-getParamAtPoint pline cp))
              )
      )
       ; Move first vertex from segment
       (modVertex pline p (inters pt1 (polar pt1 (angle pt1 pt2) 100)
  (polar (cadr pt) ang 100)
  (polar (cadr pt) ang -100)
  nil ;;here [reltro]
          )
       )
       (modVertex pline (1+ p) (inters pt4 (polar pt4 (angle pt4 pt3) 100)
       (polar (cadr pt) ang 100)
       (polar (cadr pt) ang -100)
   nil ;;here [reltro]
       )
        )
       )
     )
  (setq *error* oldError )
  (setvar "OSMODE" osm)
  (princ)
  )



greets
reltro