Topic: add circle and trim in this lisp

[Royalchill]

Need help adding circle command to draw a circle in the center of the diffuser by user's choise from 6" round to 16" round, and then trim out the inside of the circle.

Code: [Select]

;===================================================================;

(defun coords-from-center (ptc xscl yscl /  len  wid )
  (setq len (* 0.5 xscl)
        wid (* 0.5 yscl)
ptc (trans ptc 1 0)
        p1 (list (- (car ptc) len)(- (cadr ptc) wid)(caddr ptc))
        p3 (list (+ (car ptc) len)(+ (cadr ptc) wid)(caddr ptc))
        p2 (list (car p3)(cadr p1)(caddr ptc))
        p4 (list (car p1)(cadr p3)(caddr ptc)))
        (list p1 p2 p3 p4))

;===================================================================;

(defun C:dff (/ *error* call ccr clr dfc-err info ipt
       olderr opw osm p1 p2 p3 p4 xscl yscl)

(setq olderr *error*
*error* dfc-err)
(setvar "cmdecho" 0)
(command "._undo" "_g") 
(setq osm (getvar "osmode")) 
(setq opw (getvar "plinewid"))
(setq clr (getvar "clayer"))
(setq ccr (getvar "cecolor")) 
(setvar "plinewid" 0.0)
(setvar "osmode" 0) 
 
  (defun layer_set (lyr col ltp)
  (if (tblsearch "layer" lyr)
  (command "._-layer" "t" lyr "u" lyr "on" lyr  "s" lyr "")
  (command "._-layer" "row" lyr "c" col lyr "lt" ltp lyr "")))

  (layer_set "M-HDFF" "3" "Continuous")
 
;;==============================================================================;;
 
(while (or   
(initget "Supply Return Exhaust")
(setq call (getkword "\n\tChoose the diffuser > Supply, Return or Exhaust :")))

(if call
(progn
(setq xscl (getreal "\n\tX dimension < 1.0 > ?? :\n"))
(if (not xscl)(setq xscl 1.))

(setq yscl (getreal "\n\tY dimension < 1.0 > ?? :\n"))
(if (not yscl)(setq yscl 1.))

(setvar "osmode" 32)
(initget 1)
(setq ipt (getpoint "\n\tInsertion point :\n"))

(setq info (coords-from-center ipt xscl yscl))

(setq p1 (car info)
      p2 (cadr info)
      p3 (caddr info)
      p4 (last info))


(setvar "clayer" "M-HDFF")
(setvar "cecolor" "bylayer")
(cond ((eq call "Supply")
       (command "._pline")
       (mapcar 'command (list p1 p4 p3 p1 p2 p4 p3 p2))(command ""))
      ((eq call "Return")
       (command "._pline")
       (mapcar 'command (list p1 p2 p3 p1 p4 p3))(command ""))
      ((eq call "Exhaust")
       (command "._pline")
       (mapcar 'command (list p1 p4 p3 p1 p2 ipt p3 p2))(command "")))
)))
(command "._undo" "_e") 
(setvar "plinewid" opw) 
(setvar "osmode" osm)
(setvar "clayer" clr)
(setvar "cecolor" ccr) 
(setvar "cmdecho" 1)
(setq *error* olderr) 
(princ)
)

(defun dfc-err  (s)
  (princ (strcat "\nError: " s))
  (command "._undo" "_e")
  (setvar "cmdecho" 1)
  (setvar "plinewid" opw) 
  (setvar "osmode" osm)
  (setvar "clayer" clr)
  (setvar "cecolor" ccr)
  (setq *error* olderr)
  (princ))

(prompt "\n\t***\tType DFC to execute...\t***\n")
(princ)
;=======================================================================;



[CAB]

Does this help?
http://www.theswamp.org/index.php?topic=18178.0

[CAB]

Maybe this will get you going.

Code: [Select]

(setvar "clayer" "M-HDFF")
(setvar "cecolor" "bylayer")
;;===========================================
(setvar "osmode" 0)
(command "._pline")
(mapcar 'command (list p1 p2 p3 p4 "c"))
(cond ((eq call "Supply")
       (command "._line" p1 p3 "")
       (command "._line" p2 p4 ""))
      ((eq call "Return")
       (command "._line" p1 p3 ""))
      ((eq call "Exhaust")
       (command "._line" p1 p3 "")
       (command "._line" p2 ipt "")))
  (command "._circle" ipt 3.0)
  (setq ent  (entlast)
        plst nil)
  (vl-load-com)
  (foreach pa '(0 1 2 3 4 5 6 0)
    (setq plst (cons (vlax-curve-getPointAtParam ent pa) plst))
  )
  (command "._trim" ent "" "f")
  (apply 'command plst)
  (command "" "")
)))
  ;;========================================

[ronjonp]

Here is my solution. All you have to do is feed it a center point, radius, and amount of segments to be used. It will exclude items on locked layers and objects that cannot be trimmed.

Code: [Select]

(defun rjp-trimcircle (cen rad segs / cut el lst trim trim2 x cnt)
  (setq cnt 0)
  (repeat segs
    (setq lst (cons (polar cen (+ 0 (* cnt (/ (* pi 2) segs))) rad)
    lst
      )
  cnt (1+ cnt)
    )
  )
  (setq lst (append lst (list (nth 0 lst))))
  (if (setq trim (ssget "_f" lst))
    (progn
      (setq trim (vl-remove-if 'listp (mapcar 'cadr (ssnamex trim))))
      (mapcar
'(lambda (x)
   (setq el (entget x))
   (if
     (and (wcmatch (cdr (assoc 0 el))
   "ARC,CIRCLE,LINE,*POLYLINE,SPLINE"
  )
  (/= 4
      (cdr
(assoc
  70
  (entget
    (tblobjname "layer" (cdr (assoc 8 el)))
  )
)
      )
  )
     )
      (setq trim2 (cons x trim2))
   )
)
trim
      )
      (if trim2
(progn
  (setq cut (entmakex (list (cons 0 "CIRCLE")
    (cons 10 cen)
    (cons 40 rad)
      )
    )
  )
  (mapcar
    '(lambda (x)
       (command "._trim" cut "" "f")
       (apply 'command lst)
       (command "" "")
     )
    trim2
  )
  (entdel cut)
)
      )
    )
  )
  (princ)
)
(rjp-trimcircle (getpoint) (getdist) 12)

[CAB]

Ron,
Test this.

[ronjonp]

Ron,
Test this.

Doh!    Good to know. I stole some of your code and replaced above

[xiaxiang]

Here is my solution. All you have to do is feed it a center point, radius, and amount of segments to be used. It will exclude items on locked layers and objects that cannot be trimmed.

Code: [Select]

(defun rjp-trimcircle (cen rad segs / cut el lst trim trim2 x cnt)


Ron,How can I use your routine? can you specify for me?

[ronjonp]

Try this:

Code: [Select]

(defun c:xx (/ doc e el n pt rad ss)
  (vl-load-com)
  (setq doc (vlax-get-acad-object))
  (setq n -1)
  (if (setq ss (ssget '((0 . "circle"))))
    (while (setq e (ssname ss (setq n (1+ n))))
      (setq el (entget e))
      (setq pt (cdr (assoc 10 el)))
      (setq rad (cdr (assoc 40 el)))
      (vla-zoomcenter doc (vlax-3d-point pt) (* rad 3))
      (rjp-trimcircle pt rad 25)
    )
  )
)

[alanjt]

You could also use the Express Tool EXTRIM subroutine etrim.

eg.

Code: [Select]

(etrim <EName> <PointOnSideToTrim>)

[xiaxiang]

Thanks ,ron.
Thanks ,alanjt.