Segment Copy of a Region (cleaning request)

[ScottMC]

Question in code..

 

(defun c:CopyRegionEdge (/ ss) ;; AI.. https://www.google.com/search?q=copy+region+edge+segment%2C+autolisp&client=firefox-b-1-e&hs=LJSp&sca_esv=28d160b4388e87a1&biw=1143&bih=530&ei=t2enadf8OfXIp84PyJ69kA8&ved=0ahUKEwiXtPqy6oSTAxV15MkDHUhPD_I4ChDh1QMIEQ&uact=5&oq=copy+region+edge+segment%2C+autolisp&gs_lp=Egxnd3Mtd2l6LXNlcnAiImNvcHkgcmVnaW9uIGVkZ2Ugc2VnbWVudCwgYXV0b2xpc3AyCBAAGIAEGKIEMgUQABjvBTIFEAAY7wUyBRAAGO8FMgUQABjvBUjeM1C3D1iRLnABeACQAQCYAYgIoAHMC6oBBzAuNC43LTG4AQPIAQD4AQGYAgagApcNwgIIEAAYsAMY7wXCAgoQIRigARjDBBgKmAMAiAYBkAYFkgcHMS40LjYtMaAH0BCyBwcwLjQuNi0xuAffDMIHBzItMS4zLjLIB2uACAA&sclient=gws-wiz-serp
   ;; micro altered..
  (princ "\nSelect Region to Copy Edge From: ")
  
(setvar 'cmdecho 0)
  
  (if (setq ss (ssget ":S" '((0 . "REGION"))))
    
    (progn
    
	    (command "_.copybase" "0,0,0" ss "") ;; copy region to clipbrd
	    
	    (command "chprop" ss "" "c" 252 "") ;; change color
	    
	;;; ???????????
	    
	    (command "_.explode" ss)     ;; make segs accessable <not a selection set> 
	    
	   (princ "\nSelect Region Seg to Copy ")
	    
	    (command "_.copy" (ssget ":S") "" "\\" "\\") ;; select seg +copy +move
	    
	    (command "_.erase" ss "")
	    
	    (princ "\nSelect Items to Remove..") ;; <- my only known method
	    
	    (command "_.erase" "w" "\\" "\\" "") ;; <- manual erase :(
      
	    ;; ...  SEEING AS MY AUTOLISP EXPERIENCE SUCKS ..
	    ;;  how can the eXploded region / lines etc, be ERASED/selected ? 
	    ;; how to: make a selection set?
      
	    (command "chprop" "_L" "" "c" "bylayer" "") ;; ch copied to bylayer
    )
  )
  (command "_.pasteclip" "0,0,0") ;; re.place original region
  
  (setvar 'cmdecho 1) 
  (princ)
)

 

Edited 13 hours ago by ScottMC
..

[mhupp]

not sure what your trying to do. you can set entlast before the explode then add all the entities into the selection set.

 

(setq LastEnt (entlast))
(command "_.explode" ss)
(setq SS1 (ssadd)) ;create a blank selection set or add to an existing one.
(while (setq LastEnt (entnext LastEnt))
  (ssadd LastEnt SS1)
)

     

[marko_ribar]

If I understood you correctly, you are searching to something like this...

 

(defun c:copy_reg_edg ( / *error* car-sort osm cmd pt ptt regpt reg x el ell edg edgs ss m )

  (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com))

  (defun *error* ( m )
    (if osm
      (setvar (quote osmode) osm)
    )
    (if cmd
      (setvar (quote cmdecho) cmd)
    )
    (if m
      (prompt (strcat "\n" m))
    )
    (princ)
  )

  (defun car-sort ( lst fun / r )
    (setq r (car lst))
    (foreach itm (cdr lst)
      (if (apply fun (list itm r))
        (setq r itm)
      )
    )
    r
  )

  (setq osm (getvar (quote osmode)))
  (setvar (quote osmode) 3)
  (setq cmd (getvar (quote cmdecho)))
  (setvar (quote cmdecho) 0)
  (if (and (not (initget 1)) (setq pt (getpoint "\nPick edge of region to copy - you may use any OSNAP option; hover cursor over segment mid, or end point to see active OSNAP - <end,mid>... : ")) (setq regpt (nentselp pt)) (setq reg (car regpt)) (= (cdr (assoc 0 (setq x (entget reg)))) "REGION") (/= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 x))))))))
    (progn
      (setq ptt (trans pt 1 0))
      (setq el (entlast))
      (vla-explode (vlax-ename->vla-object reg))
      (while (setq el (entnext el))
        (setq ell (cons el ell))
      )
      (if (not (equal pt (osnap pt "_end")))
        (progn
          (setq edg (car-sort ell (function (lambda ( a b ) (< (distance ptt (vlax-curve-getclosestpointto a ptt)) (distance ptt (vlax-curve-getclosestpointto b ptt)))))))
          (foreach el ell
            (if (not (eq el edg))
              (entdel el)
            )
          )
          (vl-cmdf "_.move" edg "" "_non" (trans ptt 0 1) "\\")
        )
        (progn
          (setq ell (vl-sort ell (function (lambda ( a b ) (< (distance ptt (vlax-curve-getclosestpointto a ptt)) (distance ptt (vlax-curve-getclosestpointto b ptt)))))))
          (setq edgs (list (car ell) (cadr ell)))
          (foreach el (cddr ell)
            (entdel el)
          )
          (setq ss (ssadd))
          (ssadd (car edgs) ss)
          (ssadd (cadr edgs) ss)
          (vl-cmdf "_.move" ss "" "_non" (trans ptt 0 1) "\\")
        )
      )
    )
    (setq m "Missed, or picked wrong entity type - you must pick REGION entity on unlocked Layer... Better luck next time...")
  )
  (*error* (if m m))
)

 

Edited 18 minutes ago by marko_ribar

[ScottMC]

PURRRFECT!

Thanks so much 'mhupp

This gets me all.the.more excited to learn more!

[ScottMC]

Marco, when'd u write that?

let me try it...  seems to refuse

arc segs but do like your select

style

Edited 3 hours ago by ScottMC

[marko_ribar]

I tested it under AutoCAD 2022 and BricsCAD V26 and it worked well and with arced segments...

Do you receive some error messages?

[ScottMC]

(defun c:crs (/ *error* _StartUndo _EndUndo ss ss1) ;; AI.. https://www.google.com/search?q=copy+region+edge+segment%2C+autolisp&client=firefox-b-1-e&hs=LJSp&sca_esv=28d160b4388e87a1&biw=1143&bih=530&ei=t2enadf8OfXIp84PyJ69kA8&ved=0ahUKEwiXtPqy6oSTAxV15MkDHUhPD_I4ChDh1QMIEQ&uact=5&oq=copy+region+edge+segment%2C+autolisp&gs_lp=Egxnd3Mtd2l6LXNlcnAiImNvcHkgcmVnaW9uIGVkZ2Ugc2VnbWVudCwgYXV0b2xpc3AyCBAAGIAEGKIEMgUQABjvBTIFEAAY7wUyBRAAGO8FMgUQABjvBUjeM1C3D1iRLnABeACQAQCYAYgIoAHMC6oBBzAuNC43LTG4AQPIAQD4AQGYAgagApcNwgIIEAAYsAMY7wXCAgoQIRigARjDBBgKmAMAiAYBkAYFkgcHMS40LjYtMaAH0BCyBwcwLjQuNi0xuAffDMIHBzItMS4zLjLIB2uACAA&sclient=gws-wiz-serp

(princ "\nSelect Region to Copy Edge From: <oops> ")
   ;; micro altered..
   ;; https://www.cadtutor.net/forum/topic/99013-segment-copy-of-a-region-cleaning-request/#findComment-678508

(setvar 'cmdecho 0)
  
(defun *error* ( msg )
(setvar 'cmdecho 0) ;; 5.28.24
  (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
  (if msg (prompt (strcat "\n" msg)))
(setvar 'nomutt 0)
  (setvar 'cmdecho 1)    
  (princ)
)

  (defun _StartUndo ( doc ) (_EndUndo doc)
     (vla-StartUndoMark doc)
  )

  (defun _EndUndo ( doc )
    (if (= 8 (logand 8 (getvar 'UNDOCTL)))
      (vla-EndUndoMark doc)
    )
    (princ "\r")  ;; added to merge final info/cmd-line
  )
(setvar 'nomutt 1)           ;; bypass ssget 'select prompt

(if (setq ss (ssget ":S" '((0 . "REGION"))))
    
    (progn
    
	    (command "_.copybase" "0,0,0" ss "") ;; copy region to clipbrd
	    
	    (command "chprop" ss "" "c" 252 "") ;; change color

	    (setq LastEnt (entlast)) ;;  ;;; !!!!!!!!!!!!!!!! 
      
(_StartUndo doc)
    (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))

	    (command "_.explode" ss)     ;; make segs accessable, saved in 'ss to erase 
	    
      (setq SS1 (ssadd))            ;; create a blank selection set or add to an existing one., saved in 'SS1 to erase
      
      (while (setq LastEnt (entnext LastEnt))
      
                  (ssadd LastEnt SS1)
         )
         
	   (princ "\nSelect Region Segment to Copy ")
      
  	    (initget 1)
    (command "_.copy" (ssget ":S")) ;; select segment
    
     (setvar 'nomutt 1)
     (princ "\nSpecify Basepoint: ")  (command "" "\\") 
    
    (princ "\nSpecify Destination: ")  (command "\\") ;; +move
                
    (setvar 'nomutt 0)
	    
	    (command "_.erase" ss "") ;; region copied/erasure
	    
	    	    (command "_.erase" ss1 "") ;; erases exploded region
            
      (_EndUndo doc)

      
      ; (princ "\nSelect Items to Remove..") ;; <- my only known method        \
       ;                                                                                                         \
	    ; (command "_.erase" "w" "\\" "\\" "") ;; <- manual erase :(                     -- solved!!!
      ;                                                                                                          /
	    ;; ...  SEEING AS MY AUTOLISP EXPERIENCE SUCKS ..                   /
	    ;;  how can the eXploded region / lines etc, be ERASED/selected ?    /
	    ;; how to: make a selection set?                                                     / 
      
	    (command "chprop" "_L" "" "c" "bylayer" "") ;; ch copied to bylayer
    ) ;; end of progn
  ;;(c:crs)
  ) ;; end of if
  
  (command "_.pasteclip" "0,0,0") ;; re.place original region
  
(setvar 'nomutt 0)
  (setvar 'cmdecho 1) 
 (*error* nil)
  (princ)
)

Only oops is when I rt.clk after selecting region .. tried 'initget 1 but no fixy

just so glad this works. Thanks again Mr. mhupp