Author Topic: solid drill lisp error  (Read 799 times)

0 Members and 1 Guest are viewing this topic.

dussla

  • Bull Frog
  • Posts: 254
solid drill lisp error
« on: November 19, 2009, 02:52:53 AM »
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 )

)

DEVITG

  • Bull Frog
  • Posts: 426
Re: solid drill lisp error
« Reply #1 on: November 22, 2009, 06:27:43 PM »
Hi Dussla , could you upload a DWG sample and a the both Undo defun
Location @ Córdoba Argentina<br /><br />using acad 2008 under win XP