Author Topic: Really would prefer *CAB to get this section not to crash.. [Got.It!]  (Read 823 times)

0 Members and 1 Guest are viewing this topic.

ScottMC

  • Newt
  • Posts: 191
Excuse my ongoing illiteracy but if this wouldn't crash, it would really help. Any suggestions accepted. Thanks.

Code: [Select]
;;  Copy a user selected section of an entity  http://www.theswamp.org/index.php?topic=10341.0
;;  CAB 05/31/06
;;  Pick 2 clip points then pick new location for copied entity segment
(defun c:plc ( / end1 end2 endpt p1 p2 pk1 pk2 strpt)
(princ "\n ** Select: CCW ** ")
  (vl-load-com)
  (command "._undo" "_begin")
      (defun dtrim ()
      (command "._copybase" "_non" p1 ent1 "")
      (command "._pasteclip" "_non" p1)
      (command "._break" (list ent1 p1) end1)
      (command "._break" (list ent1 p2) end2)
      (command "._copybase" "_non" p2 ent1 "")
(command "._pasteclip" "\\")   ;;"_non" moved out of progn hoping to further stabilize
      )
 (if (and
        (setq pk1 (entsel "\n Pick First Polyline Trim Point."))
        (setq pk2 (entsel "\n Pick Second Polyline Trim Point."))
        (eq (car pk1) (car pk2))
        (setq ent1 (car pk1))
       (setq p1 (vlax-curve-getClosestPointTo (car pk1) (cadr pk1)))
        (setq p2 (vlax-curve-getClosestPointTo (car pk2) (cadr pk2)))
        (setq endpt (vlax-curve-getendpoint (car pk1)))
        (setq strpt (vlax-curve-getstartpoint (car pk1))) ;; ch to pk2..
        (if (< (vlax-curve-getDistAtPoint (car pk1) p1)
               (vlax-curve-getDistAtPoint (car pk2) p2)
            )
          (setq end1 strpt end2 endpt)
          (setq end2 strpt end1 endpt)
        )
     )
      (dtrim)
   )
   
      (command "._undo" "_end")

  (princ)
)
;;        ptrim was at end..
    ; (progn
      ; (command "._copybase" "_non" p1 ent1 "")
      ; (command "._break" (list ent1 p1) end1)
      ; (command "._break" (list ent1 p2) end2)
      ; (command "._pasteclip" "_non" p1)
      ; (command "._copybase" "_non" p2 ent1 "")
      ; (entdel ent1)
      ; (command "._pasteclip" "_non" pause)
      ; (command "._undo" "_end")
    ; )
   
;(prompt "\nCopy Pline section Loaded, Enter PlineClip to run.")
;(princ)

    ; (progn  ;; other suggestion..
      ; (command "._copybase" "_non" p1 ent1 "")
      ; (command "._break" (list ent1 p1) end1)
      ; (command "._break" (list ent1 p2) end2)
      ; (command "._pasteclip" "_non" p1)
      ; (command "._move" ent1 "" p2 pause)
      ; (command "._undo" "_end")
    ; )
« Last Edit: September 13, 2022, 12:18:00 PM by ScottMC »

tombu

  • Bull Frog
  • Posts: 289
  • ByLayer=>Not0
Re: Really would prefer *CAB to get this section not to crash..
« Reply #1 on: September 12, 2022, 12:58:36 PM »
What version of what software are you using?

Do any errors display on the screen?

By crash do you mean you had to restart AutoCAD?

As it's worked for others you're going to have to give more information than that.
Tom Beauford P.S.M.
Leon County FL Public Works - Windows 7 64 bit AutoCAD Civil 3D

mhupp

  • Bull Frog
  • Posts: 250
Re: Really would prefer *CAB to get this section not to crash..
« Reply #2 on: September 12, 2022, 01:05:24 PM »
This allows you to use snaps to pick points. enable nearest if you don't want to pick vertices of a polyline. Draw order (top) will affect what gets picked.

Code - Auto/Visual Lisp: [Select]
  1. ;;  Copy a user selected section of an entity  http://www.theswamp.org/index.php?topic=10341.0
  2. ;;  CAB 05/31/06
  3. ;;  Pick 2 clip points then pick new location for copied entity segment
  4. (defun c:plc (/ end1 end2 endpt p1 p2 strpt)
  5.   (princ "\n ** Select: CCW ** ")
  6.   (command "._undo" "_begin")
  7.   (if (and
  8.       (setq p1 (getpoint "\n Pick First Trim Point."))
  9.       (setq p2 (getpoint "\n Pick Second Trim Point."))
  10.       (eq (setq ent (car (nentselp p1))) (car (nentselp p2)))
  11.       (setq endpt (vlax-curve-getendpoint ent))
  12.       (setq strpt (vlax-curve-getstartpoint ent))
  13.       (if (< (vlax-curve-getDistAtPoint ent p1)
  14.              (vlax-curve-getDistAtPoint ent p2)
  15.           )
  16.           (setq end1 strpt end2 endpt)
  17.           (setq end1 endpt end2 strpt)
  18.       )
  19.     )
  20.     (progn ;used when you want to run multiple lines of code after if statment.
  21.       (command "._copybase" "_non" p1 ent "")
  22.       (command "._pasteclip" "_non" p1)
  23.       (command "._break" (list ent p1) end1)
  24.       (command "._break" (list ent p2) end2)
  25.       (command "._copybase" "_non" p2 ent "")
  26.       (command "._pasteclip" pause)
  27.       (entdel ent)
  28.     )      
  29.   )
  30.   (command "._undo" "_end")
  31.   (princ)
  32. )

ScottMC

  • Newt
  • Posts: 191
Re: Really would prefer *CAB to get this section not to crash..
« Reply #3 on: September 12, 2022, 01:27:41 PM »
** Confession.. having many cranial needs.. found the solution from MR which runs so well [Thanks]
Still, the existing original crashes my A2k :( No urgency y'all Still, Thanks for attempts to resolve.. will be tested!
https://www.theswamp.org/index.php?topic=53748.msg584210#msg584210

ScottMC

  • Newt
  • Posts: 191
Re: Really would prefer *CAB to get this section not to crash..
« Reply #4 on: September 12, 2022, 10:38:42 PM »
Got-it  https://www.theswamp.org/Smileys/black/idea.gif the copybase was causing the crash..
Sure glad this works - try it.
Code: [Select]
;;  Copy a user selected section of an entity  http://www.theswamp.org/index.php?topic=10341.0
;;  CAB 05/31/06
;;  Pick 2 clip points then pick new location for copied entity segment
(defun
    c:plc (/ end1 end2 endpt p1 p2 pk1 pk2 strpt)
  (princ "\n ** Select: CCW ** ")
  (vl-load-com)
  (if (and
        (setq pk1 (entsel "\n Pick First Polyline Trim Point."))
        (setq pk2 (entsel "\n Pick Second Polyline Trim Point."))
        (eq (car pk1) (car pk2))
        (setq ent1 (car pk1))
        (setq p1 (vlax-curve-getClosestPointTo (car pk1) (cadr pk1)))
        (setq p2 (vlax-curve-getClosestPointTo (car pk2) (cadr pk2)))
        (setq endpt (vlax-curve-getendpoint (car pk1)))
        (setq strpt (vlax-curve-getstartpoint (car pk1)))
        (if (< (vlax-curve-getDistAtPoint (car pk1) p1)
               (vlax-curve-getDistAtPoint (car pk2) p2)
            ) ;_ end of <
          (setq end1 strpt
            end2 endpt
          ) ;_ end of setq
          (setq end2 strpt
            end1 endpt
          ) ;_ end of setq
        ) ;_ end of if
      ) ;_ end of and
    (progn
      (command "._copybase" "_non" p1 ent1 "")
                                                  ;(command "._pasteclip" "_non" p1)
      (command "._break" (list ent1 p1) end1)
      (command "._break" (list ent1 p2) end2)
      (command "._copy" ent1 "" "0,0" "0,0")
      (command)
      (entdel ent1)
      (command)
      (command "._move" "L" "" p2 "\\")
      (command "._pasteclip" "_non" p1)
      (command "._undo" "_end")
    ) ;_ end of progn
  ) ;_ end of if

  (princ)
) ;_ end of defun