Segment Copy of a Region (cleaning request)

2026-03-04T03:20:43Z

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 21 hours ago by ScottMC
..

2026-03-04T04:49:13Z

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)
)

2026-03-04T13:10:02Z

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 8 hours ago by marko_ribar

2026-03-04T13:10:31Z

PURRRFECT!

Thanks so much 'mhupp

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

2026-03-04T13:13:42Z

Marco, when'd u write that?

let me try it... seems to refuse

arc segs but do like your select

style

Edited 11 hours ago by ScottMC

2026-03-04T14:25:09Z

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

Do you receive some error messages?

2026-03-04T15:16:43Z

(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

2026-03-04T23:26:32Z

Got to my original desire.. to enable access to region coords/osnaps though gonna tweak/twist to enable transparency.

Thanks much mhupp for code enabling functionality! <any other training affordable!>

(defun c:prv (/ *error* ss ss1 cec doc lastent html p) ;; 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 "\nPOints on Region Segment Vertex..(M) <oops> ")
  
   ;; https://www.cadtutor.net/forum/topic/99013-segment-copy-of-a-region-cleaning-request/#findComment-678508
;; ESC cancels leaving lines <under region/  RT.CLK erases/cleans segments made/used

(setvar 'cmdecho 0)
(vl-load-com) ;; 
  
(defun *error* ( msg )
  (setvar 'cmdecho 0) ;; 5.28.24
    (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
    (if msg (prompt (strcat "\n" msg)))
    (if (= fin 1) (command "_.pasteclip" "0,0,0")) ;; restores region if incomplete
    (setvar 'cecolor "bylayer") ;; ch copied to bylayer
      (setvar 'nomutt 0)
    (setvar 'cmdecho 1)    
   (princ)
)
  
;;//------  BIGAL  ----;; https://www.cadtutor.net/forum/topic/24751-timing/#findComment-199009
(defun ddelay (d / cd);;; (ddelay 1e-6)  = 1 Second
     (setq cd (getvar "CDATE")) 
     (while (> (+ cd d)
     (getvar "CDATE")))
   )
   
(defun ftp () ;; uses 'p for coords
   (princ
     (setq pp         ;;  make/prints coords & paste usable
      (strcat 
            (rtos (car p) 2 4) ","   
           (rtos (cadr p) 2 4) ","
         (rtos (caddr p) 2 4) 
        )
     )
   )
 )

  (setq fin 1) ;; set for *error* region restore if crash/bad.stop
  (setq cec (getvar 'cecolor)) ;; save color to restore to
  (setvar 'nomutt 1)           ;; bypass ssget 'select prompt

(if (setq ss (ssget ":S" '((0 . "REGION")))) ;; select 1 region for osnap/coords
    
    (progn
    
	    (command "_.copybase" "0,0,0" ss "") ;; copy region to clipbrd
	    
	    (command "chprop" ss "" "c" 142 "") ;; change seg's color

	    (setq LastEnt (entlast)) ;;  ;;; !!!!!!!!!!!!!!!! ;; mhupp A1 to make exploded region 
      
      (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 Vertex(s) to add POint: <no.resist> ")
      
    (initget 1)
   )    ;; end of progn 
  ) ;; end of if
  
  (while  ;; pick points loop <cancel to end picking>
      (setq p (getpoint))
      (entmakex (list (cons 0 "POINT") (cons 10 p))) ;; clean point 
      (princ "\n")
      (ftp) ;; post coords
  )

    (setvar 'nomutt 0)
	    
       (sssetfirst nil ss1) ;;temp entity highlight
        (redraw) ;; <- usually required to show..
      (ddelay 4e-7); ;; seems to allow 'short.times' <larger #'s = longer> BIGAL
       (sssetfirst nil nil) ;; <--- deselect above 'sssetfirst'

	    (command "_.erase" ss "") ;; region copied/erasure
	    
	    (command "_.erase" ss1 "") ;; erases exploded region
      
	    (command "chprop" "_L" "" "c" "bylayer" "") ;; ch copied to bylayer
    
     (command "_.pasteclip" "0,0,0") ;; re.place original region ? <- safe.r way ??
     
    (setq fin nil) ;; reset if complete
    
     	   (princ "\nCleaned.Up ")

       (setvar 'cecolor "bylayer") ;; ch current color to bylayer
      (setvar 'nomutt 0)
    (setvar 'cmdecho 1) 
   (*error* nil)
  (princ)
)

Sign In

Segment Copy of a Region (cleaning request)

Recommended Posts

ScottMC

mhupp

marko_ribar

ScottMC

ScottMC

marko_ribar

ScottMC

ScottMC

Join the conversation

Tutorials

Forums

Activity