Author Topic: Reactor question  (Read 33881 times)

0 Members and 1 Guest are viewing this topic.

LE

  • Guest
Re: Reactor question
« Reply #15 on: February 14, 2006, 06:53:59 PM »
Also... try to grip two plines and do a stretch... just one text is updated no?

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Reactor question
« Reply #16 on: February 14, 2006, 06:56:52 PM »
Yup.  I see it now.  I guess I have to have an erase reactor?  I will look at how to do that.  Thanks for pointing that one out.  Back to the drawing board.

This is fun for me though.  I'm having a good time figuring this out while working on my "REAL" work.

Also... try to grip two plines and do a stretch... just one text is updated no?
You are right again.  I should have thought of that one also.  I will see what I can do.  Thanks again Luis.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

LE

  • Guest
Re: Reactor question
« Reply #17 on: February 14, 2006, 07:03:39 PM »
I guess I have to have an erase reactor? 

Yes... and what I mentioned on my third post here... in case you find out difficult to update the VL-REACTORS list... I can help on that... but try it first.... I know you are a very smart person... keep the good programming coming.

zoltan

  • Guest
Re: Reactor question
« Reply #18 on: February 15, 2006, 11:17:49 AM »
I hope not to derail this thread by posting an alternate solution.

I  notice you are using the Object Reactor to store the area and the handle of the text in an extension dictionary of the polyline object and then creating a Command Reactor that is doing the modification to the text when the :vlr-CommandEnded callback fires.  You can do this all at once with just the Object Reactor on the Polyline object by storing the area of the Polyline and the handle of the text in the client data of the reactor object and the modifying the text when the :vlr-ObjectClosed callback fires.

You can set and retreive this data using the VLR-Data-Set and VLR-Data functions respectivelly, and you can also use it to store a flag for what to do when the object is closed, to handel the polyline getting deleted.

When you create your reactor, store the initial data and have it react to all situations:
Code: [Select]
(VLR-Object-Reactor
 (List (VLAX-EName->VLA-Object PolylineObject))
 (List '(0 . 0) ;modify flag
        (Cons 1 PolylineArea ) ;area of polyline
        (Cons 2 TextObjectHandle) ;handle of the text object
 )
 '((:vlr-Cancelled . Pline_Cancelled-Callback )
   (:vlr-Modified . Pline_Modified-Callback )
   (:vlr-Copied . Pline_Copied-Callback )
   (:vlr-Erased . Pline_Erased-Callback)
   (:vlr-UnErased . Pline_UnErased-Callback )
   (:vlr-ObjectClosed . Pline_ObjectClosed-Callback )
  )
)

Put (vlr-trace-reaction) in all of the callbacks and watch the order in whice they come down.  When the object is modified :vlr-Modified fires then :vlr-ObjectClosed.  When the object is erased :vlr-Modified fires, then :vlr-Erased, then :vlr-ObjectClosed fires.
You cannot rely on the order in which the callbacks will fire, especially when modifying multiple objects at once.  The :vlr-ObjectClosed will always fire when the object is closed for editing.  You use the other callbacks to over-write the modify flag in the client data of the reactor object and then retreive it to determine what the Pline_ObjectClosed-Callback function will do.  The Pline_Modified-Callback function will store the area of the polyline into the 1 dotted-pair of the association list.

If you want to go down this tangent, I can post lots of code snipettes, since I just finished writing a reactor that linked a lable with an object and maintained it when the object changed.  It also had to take into account not only when the object was erased and brought back with the OOPS or Undo Commands (:vlr-UnErased), but also when the object and lable were copied and the new label had to become linked to the new object.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Reactor question
« Reply #19 on: February 15, 2006, 11:25:26 AM »
Thanks zoltan.  Let me try some stuff first, as I seem to learn by doing with this type of stuff.  There is a lot to digest in your post, and since this is my first real reactor, I don't understand it all with my first read, but it looks like something I can do.  I'll post back if I get stuck.  Thanks again.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

GDF

  • Water Moccasin
  • Posts: 2081
Re: Reactor question
« Reply #20 on: February 15, 2006, 11:39:39 AM »
Tim

I tried your routine, and found it to be non persistant. I probably did something wrong. Anyway here is what I'm using.

Code: [Select]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;; Reactor Link Activex Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:LinkActiveX  ()
  (vl-load-com)
  (if (null modelSpace)
    (setq acadApp    (vlax-get-acad-object)
          docObj     (vla-get-activedocument acadApp)
          modelSpace (vla-get-modelspace docObj))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;; Area Link Reactor for ARCH_AREALINK Function ;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:AreaLinkFix-Acre  (nObj rObj pList / Objs vObj tObj)
  (if (vlax-property-available-p nObj "AREA")
    (progn (setq NewArea (vla-get-area nObj)
                 Objs    (vlr-owners rObj))
           (foreach
                  vObj  Objs
             (if (vlax-property-available-p vObj "TEXTSTRING")
               (setq tObj vObj)))
           (if tObj
             (vla-put-textstring
               tObj
               (strcat (rtos (/ NewArea 43560) 2 (getvar "useri4")) " ARCES"))))))
(defun ARCH:AreaLinkFix-SF  (nObj rObj pList / Objs vObj tObj)
  (if (vlax-property-available-p nObj "AREA")
    (progn (setq NewArea (vla-get-area nObj)
                 Objs    (vlr-owners rObj))
           (foreach
                  vObj  Objs
             (if (vlax-property-available-p vObj "TEXTSTRING")
               (setq tObj vObj)))
           (if tObj
             (vla-put-textstring
               tObj
               (strcat (rtos (/ NewArea 144) 2 (getvar "useri4")) " S.F."))))))
;;;
(defun ARCH:AreaLinkFix  (nObj rObj pList / Objs vObj tObj)
  (if (vlax-property-available-p nObj "AREA")
    (progn (setq NewArea (vla-get-area nObj)
                 Objs    (vlr-owners rObj))
           (foreach
                  vObj  Objs
             (if (vlax-property-available-p vObj "TEXTSTRING")
               (setq tObj vObj)))
           (if tObj
             (vla-put-textstring tObj (strcat (rtos (/ NewArea 144) 2 1) " S.F."))))))

;;;AutoCADET's Guide to Visual LISP - Chapter 16 Example Function Set
;;;Bill Kramer 2001

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:AREALINKIT ()
  (initget "A S") 
  (setq tmp1
(getkword
   "\n* Select Area Type:  <A>creage   <S>quare Footage *"
)
  )
  (initget 7) ;;disallow null,zero & negative
  (cond
    ((= tmp1 "A")(AREALINK-IT 43560 2 " ACRES"))
    ((or(= tmp1 "S")(= tmp1 nil))(AREALINK-IT 144 1 " S.F."))   
  )
  (princ)
)

(defun AREALINK-IT (AA DD NN / ENP ENT V_ENP V_ENT)
  (ARCH:LinkActiveX) ;;ARCH_SUBROUTINES
  ;;(ARCH:F_S-VAR)
  (setq ENP (entsel (strcat "\n* Select" NN " Polyline Boundary *")))
  (if ENP
    (progn
      (setq V_ENP
             (vlax-ename->vla-object (car ENP))
      )
      (if (vlax-property-available-p
            V_ENP
            "AREA"
          )       
        (progn         
          (setq ENT (getpoint (strcat "\n* Pick" NN " Text insertion point *")))
          ;;(ARCH:LYR "A-AREA")         
          ;;(ARCH:SET-AREA)         
          (if ENT
            (progn
              (setq V_ENT
                     (vla-addtext
                       modelSpace
                       (strcat (rtos (/ (vla-get-area V_ENP) AA) 2 DD) NN)
                       (vlax-3d-point ENT)
                       ;;(* (getvar "TEXTSIZE") 0.667)
                       ARCH#SC-T
                     )
              )
              (cond                             
                ((= tmp1 "A")
                  (setq ARCHAREA
                    (vlr-object-reactor
                      (list V_ENP V_ENT)
                      "AreaConnect"
                      '((:vlr-modified . ARCH:AreaLinkFix-Acre)) ;;ARCH_SUBROUTINES
                    )
                  )
                )
                ((or (= tmp1 "S")(= tmp1 nil))
                  (setq ARCHAREA
                    (vlr-object-reactor
                      (list V_ENP V_ENT)
                      "AreaConnect"
                      '((:vlr-modified . ARCH:AreaLinkFix-SF)) ;;ARCH_SUBROUTINES
                    )
                  )
                ) 
              )
            )
          )
        )
      )
    )
  )
  (vlr-pers ARCHAREA)
  ;;(vlr-pers-p ARCHAREA)
  ;;(vlr-pers-list)
  ;;(ARCH:F_R-VAR)
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ)

Gary
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Reactor question
« Reply #21 on: February 15, 2006, 12:00:26 PM »
Tim

I tried your routine, and found it to be non persistant. I probably did something wrong. Anyway here is what I'm using.

The first one I posted was not, but the second one was, but it still could be done better.  Thanks for posting the code will look at it when I have a chance.  Real work has come my way.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Reactor question
« Reply #22 on: February 15, 2006, 02:55:57 PM »
zoltan -
 I tried to go your way, but I couldn't do it.  I kept getting and error about object is notifying, or something like that.

This seems to work on my test drawing.  The only problem I experienced is when I didn't have the lisp file loading upon opening the drawing, then I would get errors.  Is there anyway to stop that?  Say you send out your drawings to other people, and you have reactors, but they don't have those reactor routines.  How can you have it set up so it doesn't error?  I'm sure there is a slick way that I haven't though of yet, so if anyone knows, please let me know.

Thanks again to all who helped me.

Code: [Select]
(defun c:AreaReact (/ Sel EntData PolyObj TextObj ReactList Pos)

;|  Adds a presistant reactor to a polyline object that
    updates a selected text object to the polylines area
    in square feet.  You will have to have the subs loaded
    in everydrawing for it to work, so that it know what
    to do with the reactor, because it is saved with the
    drawing.  Saves the association between the text
    and the polyline in the extension dictionary of the
    polyline.
    Thanks to Luis Esquivel for his help and guidance.
|;

(if
 (and
  (setq Sel (entsel "\n Select polyline to get area of: "))
  (setq EntData (entget (car Sel)))
  (= (cdr (assoc 0 EntData)) "LWPOLYLINE")
  (setq PolyObj (vlax-ename->vla-object (car Sel)))
  (setq Sel (entsel "\n Select text of hold area value: "))
  (setq EntData (entget (car Sel)))
  (vl-position (cdr (assoc 0 EntData)) '("TEXT" "MTEXT"))
  (setq TextObj (vlax-ename->vla-object (car Sel)))
 )
 (progn
  (PutArea PolyObj TextObj)
  (if
   (and
    (setq ReactList (AssociatedReactors PolyObj))
    (setq Pos (vl-position "MyAreaReactorModified" (mapcar 'vlr-data ReactList)))
   )
   (vlr-remove (nth Pos ReactList))
  )
  (vlr-pers
   (vlr-object-reactor
    (list PolyObj)
    "MyAreaReactorModified"
    '(
     (:vlr-modified . MakeCmdEndReactor)
     (:vlr-erased . ObjectEraseReactor)
     (:vlr-unerased . ObjectUnErasedReactor)
    )
   )
  )
 )
)
(princ)
)
;---------------------------------------------------------------------------------------------------------------
(defun PutArea (PolyObj TextObj / Dict xRec SqFt)

(setq Dict (vla-GetExtensionDictionary PolyObj))
(if (vl-catch-all-error-p (setq xRec (vl-catch-all-apply 'vla-Item (list Dict "MyAreaReactor"))))
 (setq xRec (vla-AddXRecord Dict "MyAreaReactor"))
)
(MySetXrec xRec '(40 1) (list (vlax-get PolyObj 'Area) (vlax-get TextObj 'Handle)))
(setq SqFt (/ (vla-get-Area PolyObj) 144.0))
(vla-put-TextString TextObj (strcat (rtos SqFt 2 2) " SQ.FT."))
xRec
)
;----------------------------------------------------------------------------------------------------------------
(defun MakeCmdEndReactor (Obj React NotSure)

(if GlbVarAreaObject
 (setq GlbVarAreaObject (append GlbVarAreaObject (list Obj)))
 (setq GlbVarAreaObject (list Obj))
)
(if (not GlbReactorCommandEnd)
 (setq GlbReactorCommandEnd (vlr-command-reactor nil '((:vlr-commandEnded . AdjustTextObj))))
)
(princ)
)
;------------------------------------------------------------------------------------------------------------------
(defun ObjectEraseReactor (Obj React NotSure)

(vlr-pers-release React)
(vlr-remove React)
(setq GlbReactorCommandEnd nil)
)
;-----------------------------------------------------------------------------------------------------------------
(defun ObjectUnErasedReactor (Obj React NotSure)

(vlr-pers
 (vlr-object-reactor
  (list Obj)
  "MyAreaReactorModified"
  '(
   (:vlr-modified . MakeCmdEndReactor)
   (:vlr-erased . ObjectEraseReactor)
   (:vlr-unerased . ObjectUnErasedReactor)
  )
 )
)
(setq GlbReactorCommandEnd nil)
)
;-----------------------------------------------------------------------------------------------------------------
(defun AdjustTextObj (React CommandList / Dict xRec xRecList TextObj)

(foreach Obj GlbVarAreaObject
 (if (not (vlax-erased-p Obj))
  (progn
   (setq Dict (vla-GetExtensionDictionary Obj))
   (if (not (vl-catch-all-error-p (setq xRec (vl-catch-all-apply 'vla-Item (list Dict "MyAreaReactor")))))
    (progn
     (setq xRecList (MyGetXRec xRec))
     (if
      (and
       (setq TextObj (vlax-ename->vla-object (setq tmpEnt (handent (cdr (assoc 1 xRecList))))))
       (not (vlax-erased-p TextObj))
      )
      (PutArea Obj TextObj)
     )
    )
   )
  )
 )
)
(setq GlbVarAreaObject nil)
(setq GlbReactorCommandEnd nil)
)
;---------------------------------------------------------------------------
(defun MySetXRec (Obj CodeList DataList / )
; Sets XRecordData. Dxf numbers between 1-369, except 5, 100, 105.
; See help for types and numbers to use.

(vla-SetXRecordData Obj
 (vlax-make-variant
  (vlax-safearray-fill
   (vlax-make-safearray
    vlax-vbInteger
    (cons 0 (1- (length CodeList)))
   )
   CodeList
  )
 )
 (vlax-make-variant
  (vlax-safearray-fill
   (vlax-make-safearray
    vlax-vbVariant
    (cons 0 (1- (length Datalist)))
   )
   DataList
  )
 )
)
)
;-----------------------------------------------------------------------------
(defun MyGetXRec (Obj / CodeType DataType)
; Retrive XRecordData for an object

(vla-GetXRecordData
 Obj
 'CodeType
 'DataType
)
(if (and CodeType DataType)
 (mapcar
  '(lambda (a b)
   (cons a (variant-value b))
  )
  (safearray-value CodeType)
  (safearray-value DataType)
 )
)
)
;-------------------------------------------------------------------------------------
(defun AssociatedReactors (Obj / ReactList)
; Return a list of reactors (object type) associated with an object.
; Use like (AssociatedReactors (vlax-ename->vla-object (car (entsel))))

(foreach i (cdar (vlr-reactors :vlr-object-reactor))
 (if (vl-position Obj (vlr-owners i))
  (setq ReactList (cons i ReactList))
 )
)
ReactList
)
;---------------------------------------------------------------------------
(defun RemovePersReact ()
; Remove persistant reactors that don't have an owner.

(foreach i (vlr-pers-list)
 (if (not (vlr-owners i))
  (progn
   (vlr-pers-release i)
   (vlr-remove i)
  )
 )
)
)
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

GDF

  • Water Moccasin
  • Posts: 2081
Re: Reactor question
« Reply #23 on: February 15, 2006, 03:06:36 PM »
Tim

I tried your new version...I like it. I retested my routine and yours for adding a vertice to the pline. This broke the reactor linkage.
I sure wish ther was a way ti fix this so that it would work with adding new vertices to the pline.

Gary
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Reactor question
« Reply #24 on: February 15, 2006, 03:14:07 PM »
I don't have a routine like that yet, so post yours if you can, and I will test it to see what happens.
Thanks for testing it.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

GDF

  • Water Moccasin
  • Posts: 2081
Re: Reactor question
« Reply #25 on: February 15, 2006, 03:16:09 PM »
Tim

I just remembered Peter has a lispmacro routine taht might do the trick.

Code: [Select]
From his text file:
Use the vba man to embed the lispmacro.dvb macro into a drawing.
Then load the lispmacro.lsp and dcl files into the lispmacro dialog box.
 
Then embed any lisp files you need

Peter Jamtgaard

Gary
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

GDF

  • Water Moccasin
  • Posts: 2081
Re: Reactor question
« Reply #26 on: February 15, 2006, 03:25:13 PM »
Tim

Here is the routine I use for adding a vertice to a pline. This breaks the reactor link.

Code: [Select]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;     This original Copyrighted routine has been modified...
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;ADV.LSP           ADD VERTEX TO POLYLINE         (C)2002, Aniyam Kandiyil
;;;ADDS VERTEX TO A POLYLINE WITHOUT LOOSING XDATA
;;;(command "convertpoly")
(defun c:ADV  ()
  (setvar "CMDECHO" 0)
  (setq PK_PLN (entsel
                 "\n* Pick Lightweight Polyline at point to add Vertex and Stretch *"))
  (cond ((= (cdr (assoc 0 (entget (car PK_PLN)))) "LWPOLYLINE") (ADV-IT2))
        ;|((/= (cdr (assoc 0 (entget (car PK_PLN)))) "LWPOLYLINE")
     (progn
       (setq Result (ARCH:WARNING
      "Do you want to covert the selected\n"
      "Polyline from a Heavy to a Lightweight\n"
      "Polyline?\n\n"
      "Please select an option below...\n"
    )
       )       
     )
    ) |;
        ((/= (cdr (assoc 0 (entget (car PK_PLN)))) "LWPOLYLINE")
         (progn (command "convertpoly" "l" PK_PLN "") (ADV-IT2))))
  ;;(cond
  ;;((= 0 Result) (progn (command "convertpoly" "l" PK_PLN "")(ADV-IT2)))
  ;;((= 1 Result) (ARCH:CANCEL))
  ;;)   
  (princ))

(defun ADV-IT1  ()
  (setvar "CMDECHO" 0)
  (while (or (not (setq PK_PLN
                         (entsel
                           "\n* Pick Lightweight Polyline at point to add Vertex and Stretch: *")))
             (/= (cdr (assoc 0 (entget (car PK_PLN)))) "LWPOLYLINE"))
    (ARCH:ALERT-Q
      "MsgBox \"You did not select a Lightweight Polyline.\nPlease try again.\""))
  (ADV-IT2)
  (princ))

(defun ADV-IT2  (/ CR_LYR PL_LST XD_LST PL_OPN PL_LYR PK_PNT NR_PNT NE_PNT EN_PNT AN_MID
                 EN_PNT EN_PNT1 EN_PNT2 VTX_LST)
  (setq CR_LYR  (getvar "CLAYER")
        PL_LST  (entget (car PK_PLN))
        PL_WID  (cdr (assoc 40 PL_LST))
        XD_LST  (assoc -3 (entget (car PK_PLN) (list "*")))
        PL_OPN  (cdr (assoc 70 PL_LST))
        PL_LYR  (cdr (assoc 8 PL_LST))
        PC_PNT  (cadr PK_PLN)
        PK_PNT  (osnap PC_PNT "mid")
        NR_PNT  (osnap PC_PNT "nea")
        NE_PNT  (list (car PK_PNT) (cadr PK_PNT))
        EN_PNT  (osnap PC_PNT "end")
        AN_MID  (angle PK_PNT EN_PNT)
        EN_PNT1 (list (car EN_PNT) (cadr EN_PNT))
        EN_PNT  (polar PK_PNT (+ AN_MID pi) (distance PK_PNT EN_PNT))
        EN_PNT2 (list (car EN_PNT) (cadr EN_PNT))
        VTX_LST ()) ;_ end of setq 
  (foreach
         N  PL_LST
    (if (= (car N) 10)
      (setq VTX_LST (append VTX_LST (list (cdr N))))) ;_ end of if
    ) ;_ end of foreach
  (RVS_VTX)
  (entdel (car PK_PLN))
  (setvar "CLAYER" PL_LYR)
  (setvar "PLINEWID" PL_WID)
  (command ".PLINE" (foreach PT NVTX_LST (command PT)))
  (if (= PL_OPN 1)
    (command ".pedit" (entlast) "c" "")) ;_ end of if
  (if XD_LST
    (progn (setq OBJ_LST (entget (entlast)))
           (setq OBJ_LST (append OBJ_LST (list XD_LST)))
           (entmod OBJ_LST)) ;_ end of progn
    ) ;_ end of if
  (setvar "CLAYER" CR_LYR)
  (command "stretch" "c" NR_PNT NR_PNT "" NR_PNT)
  (princ)) ;_ end of defun

(defun RVS_VTX  ()
  (setq NVTX_LST ())
  (setq FOUND NIL)
  (setq N 0)
  (setq NTH_VTX1 (nth N VTX_LST))
  (setq NTH_VTX2 (nth (+ N 1) VTX_LST))
  (while (and NTH_VTX1 NTH_VTX2)
    (progn (if (not (member NTH_VTX1 NVTX_LST))
             (setq NVTX_LST (append NVTX_LST (list NTH_VTX1)))) ;_ end of if
           (FMIDP NTH_VTX1 NTH_VTX2)
           (if (and (not (member NR_PNT NVTX_LST))
                    (= (car MIDPNT) (car NE_PNT))
                    (= (cadr MIDPNT) (cadr NE_PNT))) ;_ end of and
             (setq NVTX_LST (append NVTX_LST (list NR_PNT)))) ;_ end of if
           (if (not (equal NTH_VTX1 NTH_VTX2))
             (setq NVTX_LST (append NVTX_LST (list NTH_VTX2)))) ;_ end of if
           (setq N (+ N 1))
           (setq NTH_VTX1 (nth N VTX_LST))
           (if (not (setq NTH_VTX2 (nth (+ N 1) VTX_LST)))
             (progn (if (not (member NR_PNT NVTX_LST))
                      (setq NVTX_LST (append NVTX_LST (list NR_PNT)))) ;_ end of if
                    (setq NTH_VTX1 NIL)) ;_ end of progn
             ) ;_ end of if
           ) ;progn
    ) ;while
  ) ;_ end of defun

(defun FMIDP  (SP LP)
  (setq MIDPNT (list (/ (+ (car SP) (car LP)) 2.0) (/ (+ (cadr SP) (cadr LP)) 2.0)) ;_ end of list
        ) ;_ end of setq
  ) ;_ end of defun

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;     This original Copyrighted routine has been modified...
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Remove Pline vertice ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun drop  (lst item)
  (append (reverse (cdr (member item (reverse lst))))
          (cdr (member item lst))))
;;;
(defun massoc  (key alist / x nlist)
  (foreach
         x  alist
    (if (eq key (car x))
      (setq nlist (cons (cdr x) nlist))))
  (reverse nlist))
;;;
(defun rv  (e pt)
  (if (= (cdr (assoc 0 (setq e (entget e)))) "LWPOLYLINE")
    (progn (setvar "cmdecho" 0)
           (command "undo" "begin")
           (entmod
             (drop e
                   (cons 10
                         (if (= (type pt) 'LIST)
                           (progn (setq pt (trans pt 1 (cdr (assoc -1 e))))
                                  (list (car pt) (cadr pt)))
                           (nth pt (massoc 10 e))))))
           (command "undo" "end")
           (setvar "cmdecho" 1)
           (princ))))
;;;example--->(rv (car (entsel)) 2)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Remove Pline vertice ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun RMVIT  (/ *CURR_OSNAP olderror SelectedEntity PolyProperties iCount iCount2 NewPoly)
  (setq *CURR_OSNAP (getvar "osmode"))
  (setq olderror *error*)
  (setq *error* RVLispError)
  (setvar "cmdecho" 0)
  (command "undo" "begin")
  (setvar "osmode" 0)
  (setq SelectedEntity (car (entsel "\n* Select Pline to Remove Vertex *")))
  (if (and (/= SelectedEntity nil)
           (= (cdr (assoc 0 (entget SelectedEntity))) "LWPOLYLINE"))
    (progn (setq PolyProperties (entget SelectedEntity))
           (initget 1)
           (setvar "osmode" 32)
           (setq SelectedVertex (getpoint "\n* Pick Vertex Point to Remove *"))
           (setq iCount 0)
           (while (< iCount (cdr (assoc 90 PolyProperties)))
             (setq VertexPosition (cdr (nth (+ (* iCount 4) 14) PolyProperties)))
             (if (and (= (car VertexPosition) (car SelectedVertex))
                      (= (cadr VertexPosition) (cadr SelectedVertex)))
               (progn (setq iCount2 0)
                      (while (< iCount2 4)
                        (setq NewPoly
                               (vL-remove
                                 (nth (+ (* iCount 4) 14) PolyProperties)
                                 PolyProperties))
                        (setq iCount2 (1+ iCount2)))
                      (setq NewPoly
                             (subst (cons 90 (1- (cdr (assoc 90 PolyProperties))))
                                    (assoc 90 PolyProperties)
                                    NewPoly))
                      (entmod NewPoly)
                      (entupd (cdr (assoc -1 NewPoly)))
                      (setq iCount (cdr (assoc 90 PolyProperties)))))
             (setq iCount (1+ iCount))))
    (prompt "\n* No polylines selected! *"))
  (princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun AVXIT  (/)
  (setq cmde (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq osm (getvar "osmode"))
  (setvar "osmode" 32)
  (setq pnt (osnap (getpoint "\n* Pick intersection point *") "_int"))
  (if pnt
    (progn (setq ss (ssget "_C" pnt pnt (list (cons 0 "LWPOLYLINE,POLYLINE"))))
           (while (> (sslength ss) 0)
             (setq en (ssname ss 0))
             (command "break" en (trans pnt 1 en) "@")
             (command "pedit" "m" en "L" "" "j" 0.000 "" "")
             (ssdel en ss))))
  (setvar "cmdecho" cmde)
  (setvar "osmode" osm)
  (princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ)

Gary
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Reactor question
« Reply #27 on: February 15, 2006, 03:42:56 PM »
The problem is not my code, but yours.  The code you posted draws a new polyline.  To fix this you would need to just change the existing polyline definition, or copy the extension dictionary from the old one to the new one, and then copy the reactor (or assign a new one) to the new polyline.  Let me see if I can come up with a routine to add a new vertex to an existing polyline, so that it will keep the reactor.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

LE

  • Guest
Re: Reactor question
« Reply #28 on: February 15, 2006, 03:48:07 PM »
Tim

I just remembered Peter has a lispmacro routine taht might do the trick.

Code: [Select]
From his text file:
Use the vba man to embed the lispmacro.dvb macro into a drawing.
Then load the lispmacro.lsp and dcl files into the lispmacro dialog box.
 
Then embed any lisp files you need

Peter Jamtgaard

Gary

What ?

GDF

  • Water Moccasin
  • Posts: 2081
Re: Reactor question
« Reply #29 on: February 15, 2006, 03:49:25 PM »
Tim

Thanks, that is what I thought, because just editing the pline with pedit, doesnot distroy the reactor.

Gary
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64