Can I put a new challenge here? I've been working on this for a few
evenings now, and it works but not always (sometimes I get a fatal error).
I think this project is something that many of us could use, so all gurus out there: give it a go!
Here's the story:
The drawing:
A BIG 3D drawing (20-30Mb) with many X-refs and blocks.
I have a *defun* that xplodes all blocks and binds all xrefs, but the binding doesn't work as it should (nested xrefs?), so the xploding and binding is done manually for now.
The drawing is of a big mechanical installation with different floors on
different heights.
What the engineers want:
A section cut just above one floor and be able to see what is there and what is
underneath the floor, but not the whole way down (e.g cut at level 5,000mm and look
1,000 mm down).
Solution (
)
Make a slice between 2 planes, activate a new layout and perform a solprof on
the reamining solids.
What have I got so far :
2 lisp files:
1st file A rectangle is created at user input; the user specifies the depth
and a second rectangle is drawn (copied) at the specified depth (on separates layer).
Some x-data is added sothat the second lisp file can recognize them as 1 set.
2nd fileAll rectangles with specific x-data are put in a list, the first rectangle
in the list is collected, the accompanying rectangle is collected,
a slice is made, layout activated, solprof performed, sliced solids removed, original solids
are inserted and the second rectangle is collected,...and everything repeats.
I hope this explanation is a little clear.
So here is the routine (without error-checking; setvar's,....)
FIRST FILE;Create new layer:
(if (= (tblsearch "layer" "JDTC_SPS_Square") nil)
(entmake '((0 . "LAYER")(100 . "AcDbSymbolTableRecord")(100 . "AcDbLayerTableRecord")(2 . "JDTC_SPS_Square")(70 . 0)
(62 . 110)(6 . "CONTINUOUS"))))
(command "_layer" "t" "JDTC_SPS_Square" "set" "JDTC_SPS_Square" "")
;Create the rectangle (cutting plane)
(command "._rectangle" pause pause)
(initget 1)
(setq DVSDiepte (getreal "\nDepth of the cut..."))
(setq SPSObject1 (entlast))
(setq lastent1 (entget SPSObject1))
;Get 2 cornerpoints from the rectangle (thanks to Juerg Menzi)
(setq VLObject (vlax-ename->vla-object SPSObject1))
(setq ptlist (list (vlax-curve-getstartpoint VLObject)))
(setq Teller 1.0)
(repeat (1- (fix (vlax-curve-getendparam VLObject)))
(setq ptlist (cons (vlax-curve-getpointatparam VLObject Teller) ptlist)
Teller (1+ Teller)
)
)
(setq ptlist (cons (vlax-curve-getendpoint VLObject) ptlist))
(setq ptlist(reverse ptlist))
(setq SqPt1 (nth 0 ptlist))
(setq SqPt3 (nth 2 ptlist))
;Create second rectangle (cutting plane)
(setvar "OSMODE" 0)
(setq P1 (list 0 0 0)
P2 (list 0 0 (* -1 DVSDIEPTE)))
(command "._copy" SPSObject1 "" P1 P2)
(setq SPSObject2 (entlast)
lastent2 (entget SPSObject2))
;Determine the view in the layout because it has to match the rectangles (planes)
(command "ucs" "w")
(if (equal (car sqpt1)(car sqpt3) 0.001)
(if (= (minusp DVSDIEPTE) T)(setq Zicht "Right")(setq Zicht "Left")
)
)
(if (equal (cadr sqpt1)(cadr sqpt3) 0.001)
(if (= (minusp DVSDIEPTE) T)(setq Zicht "Back")(setq Zicht "Front")
)
)
(if (equal (caddr sqpt1)(caddr sqpt3) 0.001)
(if (= (minusp DVSDIEPTE) T)(setq Zicht "Bottom")(setq Zicht "Top")
)
)
;Create a number to strcat to the layout
;The number is saved in the drawing sothat if a layout is
;deleted, the xdata doesn't get mixed up (multiple rectangles
;with the same xdata)
(setq JDUser1 (getvar "USERI1"))
(if (= nil JDUser1)
(Progn
(setq Count 1)
)
(progn
(setq Count (+ (getvar "USERI1") 1))
(setvar "USERI1" Count)
)
)
;create a new layout
(setq JDTC_SPS_Layout_name (strcat "JIDTC_SPS_Layout " (itoa count)))
(setq JDTC_SPS_Layout_nameSec (strcat "Sec" JDTC_SPS_Layout_name));for xdata
(command "_layout" "n" JDTC_SPS_Layout_name)
(command "_layout" "s" JDTC_SPS_Layout_name)
(command "_vports" "fit")
(command "mspace")
(command "_View" "O" Zicht)
(command "_layout" "s" "model")
;Create the x-data
(regapp "JIDH-XDATA-1")
(regapp "JIDH-XDATA-2")
(setq exdata1 (list "JIDH-XDATA-1"))
(setq exdata1 (append exdata1 (list (cons '1000 JDTC_SPS_Layout_name))))
(setq newent1 (append lastent1 (list (list -3 exdata1))))
(entmod newent1)
(setq exdata2 (list "JIDH-XDATA-2"))
(setq exdata2 (append exdata2 (list (cons '1000 JDTC_SPS_Layout_nameSec))))
(setq newent2 (append lastent2 (list (list -3 exdata2))))
(entmod newent2)
SECOND FILE;Get all solids and make a block
(setq DwgModel (ssget "X" '((0 . "3DSOLID"))))
(if (= DwgModel nil)(progn
(alert "\nno solids..!")
(exit)))
(setq P0 (list 0 0 0))
(command "._block" "JDTC_SPS_Block" P0 DwgModel "")
;insert block
(defun GetModel ()
(command "ucs" "w")
(command "._insert" "JDTC_SPS_Block" P0 "1" "1" "0")
(command "._explode" (entlast))
(setq DwgModel (ssget "X" '((0 . "3DSOLID"))))
)
(GetModel)
;get middlepoint of the 2 rectangles (planes)
(defun MiddlePnt (Pnt1 Pnt2)
(mapcar '(lambda (a b)
(* 0.5 (+ a b))
)
Pnt1 Pnt2)
);end defun
;Get the cornerpoints of the rectangles (planes)
(defun DoTheCut (ptlista ptlistb VPName)
(setq SqPt1 (nth 0 ptlista))
(setq SqPt2 (nth 1 ptlista))
(setq SqPt3 (nth 2 ptlista))
(setq SqPt4 (nth 3 ptlista))
(setq SqPtA1 (nth 0 ptlistb))
(setq SqPtA2 (nth 1 ptlistb))
(setq SqPtA3 (nth 2 ptlistb))
(setq SqPtA4 (nth 3 ptlistb))
(setq MidPnt (MiddlePnt SqPt1 SqPta1))
;get the block and slice
(GetModel)
(command "._slice" DwgModel "" SqPt1 SqPt2 SqPt3 MidPnt)
(command "._slice" DwgModel "" SqPtA1 SqPtA2 SqPtA3 MidPnt)
(command "._layout" "s" VPName)
(setvar "CVPORT" 2)
;select all solids and slice + solprof
(setq DwgModel (ssget "X" '((0 . "3DSOLID"))))
(command "solprof" dwgmodel "" "" "" "")
(command "._erase" dwgmodel "")
);end defun dothecut
;Get the cornerpointslist (thanks to Juerg Menzi)
(defun GetThePoints (CutField1 Count)
(setq DvsObject (ssname CutField1 Count))
(setq DvsObject (vlax-ename->vla-object DvsObject))
(setq ptlist (list (vlax-curve-getstartpoint DvsObject)))
(setq Teller 1.0)
(repeat (1- (fix (vlax-curve-getendparam DvsObject)))
(setq ptlist (cons (vlax-curve-getpointatparam DvsObject Teller) ptlist)
Teller (1+ Teller)
)
)
(setq ptlist (cons (vlax-curve-getendpoint DvsObject) ptlist))
(setq ptlist(reverse ptlist))
);end defun Getthepoints
;Retrive the x-data
(setq CutField1 (ssget "X" '((-3 ("JIDH-XDATA-1")))))
(setq CutField2 (ssget "X" '((-3 ("JIDH-XDATA-2")))))
(setq CutField1Length (sslength CutField1))
(setq CutField2Length (sslength CutField2))
;iterate thru the rectangles (planes)
(setq Count 0)
(repeat CutField1Length
(setq ptlistA (GetThePoints Cutfield1 Count))
(setq SPSObject (entget (ssname CutField1 Count)'("JIDH-XDATA-1")))
(setq VPName (cdr (assoc 1000 (cdr (cadr (assoc -3 (cdr SPSObject)))))))
(setq VPNameSearch (strcat "Sec" VPName))
(setq CountA 0)
(repeat CutField2Length
(setq SPSObjectA (entget (ssname CutField2 CountA)'("JIDH-XDATA-2")))
(setq VPNameA (cdr (assoc 1000 (cdr (cadr (assoc -3 (cdr SPSObjectA)))))))
(if (= VPNameA VPNameSearch)(setq ptlistB (GetThePoints Cutfield2 CountA)))
(setq CountA (+ CountA 1))
);end repeat
(DoTheCut ptlista ptlistb VPName)
(setq Count (+ Count 1))
);end repeat
Let me hear something from all you Lisparians (is that a word?) out there!!