TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Royalchill on November 26, 2007, 02:10:19 PM
-
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.
;===================================================================;
(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)
;=======================================================================;
-
Does this help?
http://www.theswamp.org/index.php?topic=18178.0
-
Maybe this will get you going.
(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 "" "")
)))
;;========================================
-
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.
(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)
-
Ron,
Test this.
-
Ron,
Test this.
Doh! :-) Good to know. I stole some of your code and replaced above :P
-
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.
(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?
-
Try this:
(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)
)
)
)
-
You could also use the Express Tool EXTRIM subroutine etrim.
eg.
(etrim <EName> <PointOnSideToTrim>)
-
Thanks ,ron.
Thanks ,alanjt.
:-) :-) :-)