hello , friends
i made solid drill lisp
but there is error
i didn't found error
can you check , and modify pls ?
(defun c:CB2( / pt1 p1 p2 la2 lad copyb )
(setvar "osmode" 35 )
(setq lad (getvar "clayer"))
(setq pt1 (getpoint "\n point: "))
(setvar "osmode" 0 )
(princ)
(setq ent (entsel "\nSelect object for layer filter."))
(setq lay (cdr(assoc 8 (entget (car ent)))))
(setq p1 (getpoint "\nFirst corner :"))
(setq p2 (getcorner p1 "\nSecond corner :"))
(setq copyb (ssget "_w" p1 p2 (list '(0 . "*polyline,circle,ellipse,region")(cons 8 lay))))
(cadr(sssetfirst nil copyb))
(setq la2 "_walldrill" )
(command "-Layer" "m" la2 "c" "RED" la2 "s" la2 "")
(command "change" copyb "" "P" "la" la2 "")
(command "._COPYBASE" pt1 copyb "")
(setvar "clayer" lad)
(setvar "osmode" 35 )
)
(defun c:dr2( / lad oldec la la2 nl ent1 pt ss newss index ent entgg newobj)
(vl-load-com)
(setq act_doc (vla-get-activedocument (vlax-get-acad-object)))
(UndoBegin act_doc)
(setq lad (getvar "clayer"))
(setq oldec (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setq la "_WALLDRILL" )
(setq la2 "__im" )
(setq nl "_wall" )
(command "-Layer" "m" la2 "c" "RED" la "s" la"")
(command "-Layer" "m" nl "c" "YELLOW" nl "s" nl "")
(command "-Layer" "m" la "c" "RED" la "s" la "")
(setq ent1 (entsel "\n select big solid "))
(setvar "osmode" 35 )
(setq pt (getpoint "\nselect basepoint: "))
(command "pasteclip" pt "")
(setq ss (ssget "x" (list(cons 8 la))))
(princ)
(cadr(sssetfirst nil ss))
(command "MOVE" ss "" "0,0,0" (strcat "0,0,400"))
(setq newss (ssadd))
(setq index 0)
(repeat (sslength ss)
(setq ent (ssname ss index))
(command "extrude" ent "" -850 "" )
(setq entgg (entlast))
(ssadd entgg newss)
(setq index (1+ index))
)
(command "union" ent1 "" "")
(setq newobj2 (entlast) )
(setvar "osmode" 0)
(command "subtract" ent1 "" newobj2 "")
(setq newobj (entlast) )
(command "change" newobj "" "p" "la" NL "")
(command "draworder" newobj "" "b")
(command "regen")
(UndoEnd act_doc)
(setvar "clayer" lad)
(setvar "osmode" 35 )
)
