Jump to content

Is there a lisp to covert the flat pattern to blocks


brent_bai

Recommended Posts

I have a dwg file from others, there are sheet metal parts' flat pattern, I wants to covert each part to a blocks in its position, like Ctrl + C, and Ctrl + shift + V, move the block to the old position, and delete the old lines. There are too many parts in it, I hope there will be a lisp doing the job.

Any help would appreciate. Thanks.

Link to comment
Share on other sites

If they are polylines one of these should do the trick. if you have just lines and arcs use the Boundary Command quickly generate polylines.

 

Edited by mhupp
Link to comment
Share on other sites

Here is the test file.

I think the difficulty lies in how to choose a complete profile. Kind of like the hatch command, find the outline and all the elements in the outline.

testBlock.dwg

Edited by brent_bai
Link to comment
Share on other sites

7 hours ago, brent_bai said:

I think the difficulty lies in how to choose a complete profile.

 

Use the Join command. this will make everything polylines. then use the following on the perimeter to select it and everything inside. 

 

;;;========================================================================
;  Auto-Block Select Polyline to get it and everything inside
(defun C:AB (/ ent plist SS SS1 obj LL blkname)
  (vl-load-com)
  (if (setq ent (entsel "\nSelect Polyline To Select Objects Inside "))
    (progn
      (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent)))))
      (setq SS (ssget "_WP" plist))
      (vl-cmdf "_.Select" SS ent "")
      (setq SS1 (ssget "_P"))
    )
  )
  (Set_BlkName)
  (setvar 'attreq 0)
  (setq obj (vlax-ename->vla-object (car ent)))
  (vla-getboundingbox obj 'minpt 'maxpt)
  (setq LL (vlax-safearray->list minpt))
  (setvar 'cmdecho 0)
  (vl-cmdf "_.Block" blkname "_non" LL SS1 "")
  (vl-cmdf "_.Insert" blkname "_non" LL 1 1 0)
  (setvar 'cmdecho 1)
  (setvar 'attreq 1)
  (prompt (strcat "\nBlock [" blkname "] Created. "))
  (princ)
) 

;;;========================================================================
;;;                    *** AUTO-BLOCK.LSP ***                              
;;;     BLOCK CREATION ON THE FLY : "Just select your objects"             
;;;               By Raymond RIZKALLAH, October/2004                       
;;;========================================================================

(defun Set_BlkName ()
  (setq o-dmzn (getvar "dimzin"))
  (setvar "dimzin" 0)
  (setq c-date (getvar "cdate"))
  (setq w-all (rtos c-date 2 20))         ;; >> "20041022.11423489"
  (setq w-yr (substr w-all 3 2))          ;; ["01" to "99"] >> "04"
  (setq w-mn (substr w-all 5 2)           ;; ["A" to "L"] >> "J"
        w-mn (chr (+ 64 (read w-mn)))     ;;
  )
  (setq w-dy (substr w-all 7 2))          ;; ["A" to "Z" + "1" to "5"] >> "V"
  (if (<= (read w-dy) 26)                 ;;
    (setq w-dy (chr (+ 64 (read w-dy))))  ;;
    (setq w-dy (rtos (- (read w-dy) 26) 2 0))  ;;
  )
  (setq w-hr (substr w-all 10 2)       ;; ["A" to "S"] >> "K"
        w-hr (chr (+ 64 (read w-hr)))  ;;
  )
  (setq w-mt (strcat (substr w-all 12 1) "-" (substr w-all 13 1)))  ;; ["00" to "59"] >> "4-2"
  (setq w-sc (substr w-all 14 2))  ;; ["00" to "59"] >> "34"
  (setq w-mm (substr w-all 16 2))  ;; ["00" to "59"] >> "89"
  (setq blkname (strcat "$" w-mn w-sc w-hr w-mt w-dy w-yr w-mm))  ;; >> "$J34K4-2V0489"
  (setvar "dimzin" o-dmzn)
  (princ)
)

 

mapcar copied from here

 

Edited by mhupp
Link to comment
Share on other sites

5 hours ago, ronjonp said:

Get a copy of Bricscad and use the blockify command.

I have test Blockify command, it need to create each block first, and then the command can replace the lines by the block one by one. what I need is create the block, it's not the answer for me. Thanks.

Link to comment
Share on other sites

13 hours ago, mhupp said:

 

Use the Join command. this will make everything polylines. then use the following on the perimeter to select it and everything inside. 

 


;;;========================================================================
;  Auto-Block Select Polyline to get it and everything inside
(defun C:AB (/ ent plist SS SS1 obj LL blkname)
  (vl-load-com)
  (if (setq ent (entsel "\nSelect Polyline To Select Objects Inside "))
    (progn
      (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent)))))
      (setq SS (ssget "_WP" plist))
      (vl-cmdf "_.Select" SS ent "")
      (setq SS1 (ssget "_P"))
    )
  )
  (Set_BlkName)
  (setvar 'attreq 0)
  (setq obj (vlax-ename->vla-object (car ent)))
  (vla-getboundingbox obj 'minpt 'maxpt)
  (setq LL (vlax-safearray->list minpt))
  (setvar 'cmdecho 0)
  (vl-cmdf "_.Block" blkname "_non" LL SS1 "")
  (vl-cmdf "_.Insert" blkname "_non" LL 1 1 0)
  (setvar 'cmdecho 1)
  (setvar 'attreq 1)
  (prompt (strcat "\nBlock [" blkname "] Created. "))
  (princ)
) 

;;;========================================================================
;;;                    *** AUTO-BLOCK.LSP ***                              
;;;     BLOCK CREATION ON THE FLY : "Just select your objects"             
;;;               By Raymond RIZKALLAH, October/2004                       
;;;========================================================================

(defun Set_BlkName ()
  (setq o-dmzn (getvar "dimzin"))
  (setvar "dimzin" 0)
  (setq c-date (getvar "cdate"))
  (setq w-all (rtos c-date 2 20))         ;; >> "20041022.11423489"
  (setq w-yr (substr w-all 3 2))          ;; ["01" to "99"] >> "04"
  (setq w-mn (substr w-all 5 2)           ;; ["A" to "L"] >> "J"
        w-mn (chr (+ 64 (read w-mn)))     ;;
  )
  (setq w-dy (substr w-all 7 2))          ;; ["A" to "Z" + "1" to "5"] >> "V"
  (if (<= (read w-dy) 26)                 ;;
    (setq w-dy (chr (+ 64 (read w-dy))))  ;;
    (setq w-dy (rtos (- (read w-dy) 26) 2 0))  ;;
  )
  (setq w-hr (substr w-all 10 2)       ;; ["A" to "S"] >> "K"
        w-hr (chr (+ 64 (read w-hr)))  ;;
  )
  (setq w-mt (strcat (substr w-all 12 1) "-" (substr w-all 13 1)))  ;; ["00" to "59"] >> "4-2"
  (setq w-sc (substr w-all 14 2))  ;; ["00" to "59"] >> "34"
  (setq w-mm (substr w-all 16 2))  ;; ["00" to "59"] >> "89"
  (setq blkname (strcat "$" w-mn w-sc w-hr w-mt w-dy w-yr w-mm))  ;; >> "$J34K4-2V0489"
  (setvar "dimzin" o-dmzn)
  (princ)
)

 

mapcar copied from here

 

I have test your lsp file, it worked. Only one problem left: I need to select the profile one by one to create the block. Usually there are more than 500 parts in a drawing like this, which is a lot of work. Anyway thank you!

Link to comment
Share on other sites

The issue is the fact that your outlines have buldges. Now if all segments of the polyline outside was straight, it could be accurate and I would know how to do the whole lot in one shot. But judging by your drawing, it won't be much effect.

Link to comment
Share on other sites

11 hours ago, brent_bai said:

Only one problem left: I need to select the profile one by one to create the block. Usually there are more than 500 parts in a drawing like this, which is a lot of work. Anyway thank you!

 

This is why its important to post all relevant information.

1 Create a new temp layer and draw a rectangle around all geometry you want to block. (better if you use a different color so its easier to see)

2 Use the boundary command and on the island option pick outer. (see attached drawing)

3 Delete the large rectangle and run this ab command. (still needs  the Set_BlkName lisp)

 

One problem with this

All the original perimeter polylines are not in the block. These should be deleted. overkill mabye?

Also if you don't mind spam take out the nomutt lines.

 

;;;========================================================================
(defun C:AB (/ i plist SS SS1 obj LL UR blkname)
  (vl-load-com)
  (setq i 0)
  (setq lay (getvar 'clayer))
  (if (setq SS (ssget "X" (list (cons 0 "LWPOLYLINE") (cons 8 lay))))
    (progn
      (setvar 'nomutt 1)
      (repeat (sslength SS)
        (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname SS i)))))
        (setq SS1 (ssget "_WP" plist))
        (vl-cmdf "_.chprop" (ssname SS i) "" "LA" "0" "")         ;everything was on layer 0 if you need it on a diffrent layer change it here
        (vl-cmdf "_.Select" SS1 (ssname SS i) "")
        (setq SS2 (ssget "_P"))
        (Set_BlkName)
        (setvar 'attreq 0)
        (setq obj (vlax-ename->vla-object (ssname SS i)))
        (vla-getboundingbox obj 'minpt 'maxpt)
        (setq LL (vlax-safearray->list minpt))  ;lower left point
        (setvar 'cmdecho 0)
        (vl-cmdf "_.Block" blkname "none" LL SS2 "")
        (vl-cmdf "_.Insert" blkname "none" LL 1 1 0)
        (setvar 'cmdecho 1)
        (setvar 'attreq 1)
        (setq i (1+ i))
        ;(prompt (strcat "\nBlock [" blkname "] Created. ")) ;with nomutt on will not display
      )
      (setvar 'nomutt 0)
    )
  )
  (if (setq SS (ssget "X" (list (cons 8 lay)))) ;selects everything on temp layer
    (progn
      (setq i (sslength SS))
      (setq i (rtos i 2 0))
      (prompt (strcat "\n" i " Objects Moved to 0 layer"))
      (setvar 'nomutt 1)
      (vl-cmdf "_Chprop" SS "" "LA" "0" "")
      (setvar 'clayer "0")
      (vl-cmdf "_Purge" "LA" lay "N")
      (setvar 'nomutt 0)
    )
  )
  (setvar 'nomutt 0)
  (princ)
)

 

 

 

 

Testblock.dwg

Edited by mhupp
  • Thanks 1
Link to comment
Share on other sites

Just now, brent_bai said:

Dear mhupp, Great job!

I tested your lsp, it worked for me. Thanks a lot!

 

Show me some love and hit the hearts to the right ------->

  • Thanks 1
Link to comment
Share on other sites

5 hours ago, mhupp said:

 

This is why its important to post all relevant information.

1 Create a new temp layer and draw a rectangle around all geometry you want to block. (better if you use a different color so its easier to see)

2 Use the boundary command and on the island option pick outer. (see attached drawing)

3 Delete the large rectangle and run this ab command. (still needs  the Set_BlkName lisp)

 

One problem with this

All the original perimeter polylines are not in the block. These should be deleted. overkill mabye?

Also if you don't mind spam take out the nomutt lines.

 





;;;========================================================================
(defun C:AB (/ i plist SS SS1 obj LL UR blkname)
  (vl-load-com)
  (setq i 0)
  (setq lay (getvar 'clayer))
  (if (setq SS (ssget "X" (list (cons 0 "LWPOLYLINE") (cons 8 lay))))
    (progn
      (setvar 'nomutt 1)
      (repeat (sslength SS)
        (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname SS i)))))
        (setq SS1 (ssget "_WP" plist))
        (vl-cmdf "_.chprop" (ssname SS i) "" "LA" "0" "")         ;everything was on layer 0 if you need it on a diffrent layer change it here
        (vl-cmdf "_.Select" SS1 (ssname SS i) "")
        (setq SS2 (ssget "_P"))
        (Set_BlkName)
        (setvar 'attreq 0)
        (setq obj (vlax-ename->vla-object (ssname SS i)))
        (vla-getboundingbox obj 'minpt 'maxpt)
        (setq LL (vlax-safearray->list minpt))  ;lower left point
        (setvar 'cmdecho 0)
        (vl-cmdf "_.Block" blkname "none" LL SS2 "")
        (vl-cmdf "_.Insert" blkname "none" LL 1 1 0)
        (setvar 'cmdecho 1)
        (setvar 'attreq 1)
        (setq i (1+ i))
        ;(prompt (strcat "\nBlock [" blkname "] Created. ")) ;with nomutt on will not display
      )
      (setvar 'nomutt 0)
    )
  )
  (if (setq SS (ssget "X" (list (cons 8 lay)))) ;selects everything on temp layer
    (progn
      (setq i (sslength SS))
      (setq i (rtos i 2 0))
      (prompt (strcat "\n" i " Objects Moved to 0 layer"))
      (setvar 'nomutt 1)
      (vl-cmdf "_Chprop" SS "" "LA" "0" "")
      (setvar 'clayer "0")
      (vl-cmdf "_Purge" "LA" lay "N")
      (setvar 'nomutt 0)
    )
  )
  (setvar 'nomutt 0)
  (princ)
)

 

 

 

 

Testblock.dwg 71.74 kB · 1 download

 

You kinda beat me to it... Check this out: Outline Objects

 

You can call LM:outline and the use its return value to do your stuff and iterate through each one. The function basically follows your approach (which was also my idea), and in a whole command instead. This way you won't have to worry about creating another rectangle and another temporary layer, and you will have a solid selection set containing the outlines of each geometry.

 

P.S. I always hate having to hard-code layer-related codes because sometimes for programs to work (not in this case), you'll need to check for whether the layers are locked or frozen.

Edited by Jonathan Handojo
Link to comment
Share on other sites

It only worked in BricsCAD because of the boundary command. The other CAD software will convert all the lines to boundary, whether you select the outer island detection.

The outline objects lsp also have this issue.

Link to comment
Share on other sites

Your right @Jonathan Handojo Everything should be in one command. If you ran the above code with out creating a new layer that would cause problems.

 

this will

create a temp layer Block change this name to something unique that isn't in any of your drawings

Ask you to draw a rectangle around what you want to block

Join everything inside that rectangle (this could be skipped)

run the boundary Command

let you select the 2 perimeter rectangles and delete them

make individual blocks

prompt & move # objects moved to layer 0

purge block layer

 

Still need to delete left over perimeter polylines. because i found out polylines can be exactly the same in every way but if they have different starting points overkill wont work on them.

 

 

;;;========================================================================
(defun C:AB (/ i lay rec obj pline plist SS SS1 obj LL UR blkname)
  (vl-load-com)
  (setq i 0)
  (vl-cmdf "-Layer" "M" "BLOCK" "Color" "Red" "" "Plot" "No" "" ""))
  (setvar 'clayer "BLOCK")
  (setq lay (getvar 'clayer))
  (prompt "\nDraw Rectangle Around Geometry you Want to Block")
  (vl-cmdf "_.Rectangle" pause pause)  
  (setq rec (entlast))
  (setq obj (vlax-ename->vla-object rec))
  (vla-getboundingbox obj 'minpt 'maxpt)
  (setq LL (vlax-safearray->list minpt)
        UR (vlax-safearray->list maxpt)
  )
  (setq SS (ssget "W" LL UR))
  (vl-cmdf "_.join" SS ""join)
  (vl-cmdf "-BOUNDARY" "A" "I" "O" "X" pause "")
  (prompt "\nDelete Permeter Rectangles no longer needed select to Delete")  
  (setq SS2 (ssget))
  (command "_.Erase" SS2 "")
  (if (setq SS (ssget "X" (list (cons 0 "LWPOLYLINE") (cons 8 lay))))
    (progn
      (repeat (sslength SS)
        (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname SS i)))))
        (setq SS1 (ssget "_WP" plist))
        (setvar 'nomutt 1)
        (vl-cmdf "_.chprop" (ssname SS i) "" "LA" "0" "")  ;everything was on layer 0 if you need it on a diffrent layer change it here
        (vl-cmdf "_.Select" SS1 (ssname SS i) "")
        (setq SS2 (ssget "_P"))
        (Set_BlkName)
        (setvar 'attreq 0)
        (setq obj (vlax-ename->vla-object (ssname SS i)))
        (vla-getboundingbox obj 'minpt 'maxpt)
        (setq LL (vlax-safearray->list minpt))             ;lower left point
        (vl-cmdf "_.Block" blkname "none" LL SS2 "")
        (vl-cmdf "_.Insert" blkname "none" LL 1 1 0)
        (setvar 'attreq 1)
        (setq i (1+ i))
        (setvar 'nomutt 0)
        (prompt (strcat "\nBlock [" blkname "] Created. "))
      )
    )
  )
  ;;;========================================================================
(defun C:AB (/ i lay rec obj pline plist SS SS1 obj LL UR blkname)
  (vl-load-com)
  (setq i 0)
  (if (not (tblsearch "layer" "BLOCK")) (vl-cmdf "-Layer" "M" "BLOCK" "Color" "Red" "" "Plot" "No" "" ""))
  (setvar 'clayer "BLOCK")
  (setq lay (getvar 'clayer))
  (prompt "\nDraw Rectangle Around Geometry you Want to Block")
  (vl-cmdf "_.Rectangle" pause pause)  
  (setq rec (entlast))
  (setq obj (vlax-ename->vla-object rec))
  (vla-getboundingbox obj 'minpt 'maxpt)
  (setq LL (vlax-safearray->list minpt)
        UR (vlax-safearray->list maxpt)
  )
  (setq SS (ssget "W" LL UR))
  (vl-cmdf "_.join" SS ""join)
  (vl-cmdf "-BOUNDARY" "A" "I" "O" "X" pause "")
  (prompt "\nDelete Permeter Rectangles no longer needed select to Delete")  
  (setq SS2 (ssget))
  (command "_.Erase" SS2 "")
  (if (setq SS (ssget "X" (list (cons 0 "LWPOLYLINE") (cons 8 lay))))
    (progn
      (repeat (sslength SS)
        (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname SS i)))))
        (setq SS1 (ssget "_WP" plist))
        (setvar 'nomutt 1)
        (vl-cmdf "_.chprop" (ssname SS i) "" "LA" "0" "")  ;everything was on layer 0 if you need it on a diffrent layer change it here
        (vl-cmdf "_.Select" SS1 (ssname SS i) "")
        (setq SS2 (ssget "_P"))
        (Set_BlkName)
        (setvar 'attreq 0)
        (setq obj (vlax-ename->vla-object (ssname SS i)))
        (vla-getboundingbox obj 'minpt 'maxpt)
        (setq LL (vlax-safearray->list minpt))             ;lower left point
        (vl-cmdf "_.Block" blkname "none" LL SS2 "")
        (vl-cmdf "_.Insert" blkname "none" LL 1 1 0)
        (setvar 'attreq 1)
        (setq i (1+ i))
        (setvar 'nomutt 0)
        (prompt (strcat "\nBlock [" blkname "] Created. "))
      )
    )
  )
  (if (setq SS (ssget "X" (list (cons 8 lay))))            ;selects everything on BLOCK layer
    (progn
      (setq i (sslength SS))
      (prompt (strcat "\n" (rtos i 2 0) " Objects Moved to 0 layer"))
      (setvar 'nomutt 1)
      (vl-cmdf "_Chprop" SS "" "LA" "0" "")
      (setvar 'clayer "0")
      (vl-cmdf "_Purge" "LA" lay "N")
      (setvar 'nomutt 0)
    )
  )
  (setvar 'nomutt 0)
  (princ)
)

 

Link to comment
Share on other sites

@mhupp @brent_bai How about this? (with thanks to Lee Mac's Outline Objects routine)

 

(defun c:test ( / blk cmd ent enx i n ol os ss ssb)
    (LM:startundo (LM:acdoc))
    (and
	(setq ss (ssget "_:L"))
	(setq os (getvar 'osmode)
	      cmd (getvar 'cmdecho)
	      n 0
	      ol (LM:outline ss)
	      )
	(progn
	    (mapcar 'setvar '(osmode cmdecho) '(0 0))
	    (repeat (setq i (sslength ol))
		(if
		    (and
			(eq
			    (cdr
				(assoc 0
				       (setq i (1- i)
					     ent (ssname ol i)
					     enx (entget ent)
					     )
				       )
				)
			    "LWPOLYLINE"
			    )
			(setq
			    ssb (ssget "_CP"
				       (mapcar 'cdr
					       (vl-remove-if-not
						   '(lambda (a)
							(= (car a) 10)
							)
						   enx
						   )
					       )
				       )
			    )
			(progn
			    (ssdel ent ssb)
			    (while (tblsearch "block" (setq n (1+ n) blk (strcat "Block" (itoa n)))))
			    (vl-cmdf "_.Block" blk "_non" '(0.0 0.0 0.0) ssb "")
			    (vl-cmdf "_.Insert" blk "_non" '(0.0 0.0 0.0) 1 1 0)
			    )
			)
		    (entdel ent)
		    )
		)
	    (mapcar 'setvar '(osmode cmdecho) (list os cmd))
	    )
	)
    (LM:endundo (LM:acdoc))
    (princ)
    )

;; Outline Objects  -  Lee Mac
;; Attempts to generate a polyline outlining the selected objects.
;; sel - [sel] Selection Set to outline
;; Returns: [sel] A selection set of all objects created
 
(defun LM:outline ( sel / app are box cmd dis enl ent lst obj rtn tmp )
    (if (setq box (LM:ssboundingbox sel))
        (progn
            (setq app (vlax-get-acad-object)
                  dis (/ (apply 'distance box) 20.0)
                  lst (mapcar '(lambda ( a o ) (mapcar o a (list dis dis))) box '(- +))
                  are (apply '* (apply 'mapcar (cons '- (reverse lst))))
                  dis (* dis 1.5)
                  ent
                (entmakex
                    (append
                       '(   (000 . "LWPOLYLINE")
                            (100 . "AcDbEntity")
                            (100 . "AcDbPolyline")
                            (090 . 4)
                            (070 . 1)
                        )
                        (mapcar '(lambda ( x ) (cons 10 (mapcar '(lambda ( y ) ((eval y) lst)) x)))
                           '(   (caar   cadar)
                                (caadr  cadar)
                                (caadr cadadr)
                                (caar  cadadr)
                            )
                        )
                    )
                )
            )
            (apply 'vlax-invoke
                (vl-list* app 'zoomwindow
                    (mapcar '(lambda ( a o ) (mapcar o a (list dis dis 0.0))) box '(- +))
                )
            )
            (setq cmd (getvar 'cmdecho)
                  enl (entlast)
                  rtn (ssadd)
            )
            (while (setq tmp (entnext enl)) (setq enl tmp))
            (setvar 'cmdecho 0)
            (command
                "_.-boundary" "_a" "_b" "_n" sel ent "" "_i" "_y" "_o" "_p" "" "_non"
                (trans (mapcar '- (car box) (list (/ dis 3.0) (/ dis 3.0))) 0 1) ""
            )
            (while (< 0 (getvar 'cmdactive)) (command ""))
            (entdel ent)
            (while (setq enl (entnext enl))
                (if (and (vlax-property-available-p (setq obj (vlax-ename->vla-object enl)) 'area)
                         (equal (vla-get-area obj) are 1e-4)
                    )
                    (entdel enl)
                    (ssadd  enl rtn)
                )
            )
            (vla-zoomprevious app)
            (setvar 'cmdecho cmd)
            rtn
        )
    )
)
 
;; Selection Set Bounding Box  -  Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; s - [sel] Selection set for which to return bounding box
 
(defun LM:ssboundingbox ( s / a b i m n o )
    (repeat (setq i (sslength s))
        (if
            (and
                (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
                (vlax-method-applicable-p o 'getboundingbox)
                (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
            )
            (setq m (cons (vlax-safearray->list a) m)
                  n (cons (vlax-safearray->list b) n)
            )
        )
    )
    (if (and m n)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
    )
)
 
;; Start Undo  -  Lee Mac
;; Opens an Undo Group.
 
(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)
 
;; End Undo  -  Lee Mac
;; Closes an Undo Group.
 
(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)
 
;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object
 
(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)
 
(vl-load-com) (princ)

 

Edited by Jonathan Handojo
Link to comment
Share on other sites

I Tried his lisp but it outlines everything and you just want to outline the perimeter so you can use the ssget "WP"

Your lisp has alot of nested blocks. That code is so over my head i don't know even where to start.

 

nested.png

 

Your lisp is probably better suited for Brent If he is using it like I think he is. Laying out parts to be cut on a machine he doesn't want to wonder if he selected all the internal geometry. So moving blocks around takes the guess work out of it. Just remember to explode everything twice and you should be good to go.

 

Edited by mhupp
Link to comment
Share on other sites

 

@mhupp Your new lsp can not be loaded, error : bad argument type <"BLOCK"> ; expected <STRING> at [setvar]. I try your last lsp by your steps, it worked in BricsCAD, sometimes does not work in other CAD software. I tried the join command and boundary command to create the outline, sometimes it will fail to create polylines by unknown reason. I can't find the cause. The dwg file exported by SolidWorks, I checked there is not tiny gap between lines. Thank you all the time!

@Jonathan Handojo Thank you! Your lisp is suited for me. It not work in NanoCAD (free version), it tell me "error: invalid SSGET mode string", may be the software version is too low to support ssget method. But it worked in BricsCAD(trail version), I will come to the company to test your lsp by ZWCAD2021 on Monday. Thanks.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...