[编程交流] 多弧圆角？

;*************************************************************
;* DTanArc.lsp                        (c) 2010  Lloyd Beachy *
;*                                    questecheng2@gmail.com *
;* --------------------------------------------------------- *
;* A routine to draw a tangent arc from the endpoint of an   *
;* existing line or arc.  The tangency point can be adjusted *
;* dynamically with the "+" & "-" keys.                      *
;*************************************************************
;main function
(defun C:DTA (/ osm osm2 cmd ent sel_pt _type end1 end2 pt1 _cen _rad _ang1 _ang2 _quit mpt arc)
 (setq osm(getvar "osmode")                        ;record original settings
osm2(find_osm osm)
cmd(getvar "cmdecho"))
 (setvar "osmode" 0)
 (setvar "cmdecho" 0)
 (setq ent(val_entsel "\nSelect a line or arc:  " 0 "LINE,ARC");filtered entsel
sel_pt(cadr ent)                        ;selection point
ent(entget(car ent))                        ;entity data
_type(cdr(assoc 0 ent))                        ;entity type
end3(cadr(grread t 1 0)))                ;endpoint of new arc
 (cond((= _type "LINE"); --------------------------------------------- LINE
(setq end1(cdr(assoc 11 ent))                ;endpoint1
      end2(cdr(assoc 10 ent)))                ;endpoint2
(if(<(distance end2 sel_pt)(distance end1 sel_pt));if end2 is closest to sel_pt...
  (setq pt1 end2 end2 end1 end1 pt1))        ;reverse endpoints
(setq ang(angle end2 end1))                ;tangency angle of new arc
(while(null _quit)(dta_grread))                ;enter preview loop
);end "LINE" cond
      ((= _type "ARC"); ---------------------------------------------- ARC
(setq _cen(cdr(assoc 10 ent))                ;center point
      _rad(cdr(assoc 40 ent))                ;radius
      _ang1(assoc 50 ent)                ;start angle
      _ang2(assoc 51 ent)                ;end angle
      end1(polar _cen(cdr _ang1)_rad)        ;endpoint1
      end2(polar _cen(cdr _ang2)_rad))        ;endpoint2
(if(<(distance end2 sel_pt)(distance end1 sel_pt));if end2 is closest to sel_pt...
  (setq end1 end2 _ang1 _ang2 ang(+(cdr _ang1)(* pi 0.5)));reverse points then find tangency angle of new arc
  (setq ang(+(cdr _ang1)(* pi 1.5))))        ;find tangency angle of new arc
(while(null _quit)(dta_grread))                ;enter preview loop
 ));end entity type cond
 (command ".draworder" (ssadd(cdr(assoc -1 arc))(ssadd(cdr(assoc -1 ent)))) "" "front");move new arc and selected entity to front
 (redraw)
 (setvar "osmode" osm)                                ;restore settings...
 (setvar "cmdecho" cmd)
 (princ)
);end C:DTA
(defun dta_grread (/ val end3 _end3 dist)
 (setq val(grread t 3 0))                        ;read user action
 (cond((= 5(car val));------------------------------------------------ Cursor moved
(if arc(entmod(subst(cons 40 0.01)(assoc 40 arc)arc)));change preview arc to not interfere with osnap point
(setq _end3(osnap(cadr val)osm2)        ;find osnap point
      end3(if _end3 _end3(cadr val)))        ;use osnap point if defined, otherwise, use actual point
(if arc(entmod arc))                        ;restore preview arc
);end move cond
      ((= 2(car val));------------------------------------------------ Key pressed
(setq dist(*(getvar "viewsize")0.008))        ;incrimental distance
(if(= 45(cadr val))                        ;if "-" was pressed...
  (setq dist(* dist -1))                ;set dist to negative
  (if(= 13(cadr val))                        ;if "Enter" was pressed...
    (setq dist nil _quit t)                ;set flag to exit loop
    (if(/= 43(cadr val))                ;if "+" was not pressed...
      (setq dist nil)                        ;clear dist value
    );end "+" if
  );end "Enter" if
);end "-" if
(if dist                                ;if dist is still set...
  (cond((= _type "LINE");---Original entity was a line
        (setq end1(polar end1 ang dist)        ;new line endpoint
              ent(subst(cons 10 end1)(assoc 10 ent)ent);update endpoint1
              ent(entmod(subst(cons 11 end2)(assoc 11 ent)ent)));update endpoint2 & update original line
       );end "LINE" cond
       ((= _type "ARC");---Original entity was an arc
        (if(= 51(car _ang1))                ;update variables based on original arc's direction
          (setq _ang1(cons 51(+(cdr _ang1)(/ dist _rad)));new ending angle
                end1(polar _cen(cdr _ang1)_rad);new endpoint
                ang(+(cdr _ang1)(* pi 0.5));new tangency angle
                ent(entmod(subst _ang1(assoc 51 ent)ent)));update original arc
          (setq _ang1(cons 50(-(cdr _ang1)(/ dist _rad)));new ending angle
                end1(polar _cen(cdr _ang1)_rad);new endpoint
                ang(+(cdr _ang1)(* pi 1.5));new tangency angle
                ent(entmod(subst _ang1(assoc 50 ent)ent)));update original arc
        )
   ));end "ARC" cond
);end dist if
      );end key cond
      ((= 3(car val));------------------------------------------------ Point selected
(if arc(entmod(subst(cons 40 0.01)(assoc 40 arc)arc)));change preview arc to not interfere with osnap point
(setq _end3(osnap(cadr val)osm2)        ;find osnap point
      end3(if _end3 _end3(cadr val))        ;use osnap point if defined, otherwise, use actual point
      _quit t)                                ;set _quit flag
(if arc(entmod arc))                        ;restore preview arc
      );end point cond
 );end cond
 (if end3                                        ;if end3 is defined,
   (if(and(null(equal ang(angle end3 end1)0.001));both endpoints are not in-line with tangency angle, and
   (/= 0.0(distance end1 end3)))        ;endpoints are not identical...
     (dta_preview end1 ang end3)                ;then, update preview arc
   );end if
 );end end3 if
);end dta_grread
;build string value that matches "osmode" value (for use with "osnap" function)
(defun find_osm (osm / osm2)
 (setq osm2 "")
 (if(< osm 16384)
   (foreach _code '((8192 "par")(4096 "ext")(2048 "app")(1024 "")(512 "nea")(256 "tan")(128 "per")(64 "ins")(32 "int")(16 "qua")(8 "nod")(4 "cen")(2 "mid")(1 "end"))
     (if(>= osm(car _code))
(setq osm(- osm(car _code))
      osm2(strcat osm2(if(and(/= osm2 "")(/= (cadr _code)""))"," "")(cadr _code)))
     );end if
   );end foreach
 );end if
 osm2                                                ;return string value
);end find_osm
;modify preview arc to match supplied endpoints and tangency angle
(defun dta_preview (end1 ang end3 / mpt cen ang1 ang2 ang3 rad pt1 pt2)
 (redraw)
 (setq ang1(angle end1 end3)                        ;cord angle
mpt(polar end1 ang1(/(distance end1 end3)2.0));cord midpoint
cen(inters end1 (polar end1(+ ang(* pi 0.5))1.0) mpt (polar mpt(+ ang1(* pi 0.5))1)nil);arc centerpoint
ang1(angle cen end1)                        ;start angle of arc
ang2(angle cen end3)                        ;end angle of arc
rad(distance cen end1)                        ;arc radius
pt1(polar end1 ang 1.0)                        ;1st check point (to test arc direction)
pt2(polar cen (- ang1 0.0001) rad))        ;2nd check point (to test arc direction)
 (if(> 1.0(distance pt1 pt2))                        ;if arc direction is reversed...
   (setq ang3 ang1 ang1 ang2 ang2 ang3))        ;reverse starting and ending angles
 (grdraw end1(polar end1(angle end1 cen)(*(getvar "viewsize")0.04))6 1);show tangency reference line
 (if(null arc)                                        ;if new arc does not exist...
   (setq arc(command ".arc" "c" cen (polar cen ang1 rad)(polar cen ang2 rad));draw new arc
  arc(entget(ssname(ssget "l")0)))        ;new arc entity data
   (setq arc(subst(cons 10 cen)(assoc 10 arc)arc);update data with new centerpoint
  arc(subst(cons 40 rad)(assoc 40 arc)arc);update data with new radius
  arc(subst(cons 50 ang1)(assoc 50 arc)arc);update data with new start angle
  arc(entmod(subst(cons 51 ang2)(assoc 51 arc)arc)));update data with new end angle & update arc
 );end arc if
);end dta_preview
;Select an entity with a validation requirement.                                  ;
; -> function requires these arguments: (val_entsel "prompt" group_code value)    ;
;The following examples will allow selection of a specific type(s) or color       ;
;  (val_entsel "\nSelect a line, arc or polyline:  " 0 "LWPOLYLINE,LINE,ARC")     ;
;  (val_entsel "\nSelect a red object:  " 62 1)                                   ;
(defun val_entsel (_prompt _code _value / ent _type)
 (while(null ent)
   (setq ent(entsel _prompt))
   (if ent                        ;if object was selected...
     (progn                        ;check against validation argument
(setq _type(cdr(assoc _code(entget(car ent)))))
(if(=(type _type)'STR)        ;if not valid, set ent nil
  (if(null(vl-remove-if-not '(lambda(item)(if(= _code(car item))(if(wcmatch(strcase(cdr item))(strcase _value))t)))(entget(car ent))))
    (setq ent nil)
    );end if
  (if(/= _type _value)(setq ent nil))
);end if
(if(null ent)                ;print warning if ent was not valid
  (princ "\nObject was not a valid type")
);end if
     );end progn
     (princ "No object selected!")
   );end if
 );end while
 ent                                ;return entity name and selection point
);end val_entsel

;;; CADALYST 05/08  www.cadalyst.com/code 
;;; Tip 2290: Arctodo.LSP        Tangent Arc Generators, File 1 of 5  (c) 2008 Rogelio Bravo
;; ARCTODO draws an arc tangent to any kind of object
;; picking any other point as end point of arc
;; written by Rogelio Bravo, Spain
(defun C:arctodo ()
  (graphscr)
 (vl-load-com)
 (setq obj (car (entsel "\nPick base entity for arc:")))
 (setq ref (getvar "osmode"));almacena valor inicial de osmode
 (command "_osnap"  "_end,_nea");establece nuevos refent
 (setq ptan (getpoint "\nPick, on entity, initial point of arc:"))
 (setvar "osmode" ref);restablece valores iniciales de osmode
 (setq pam (vlax-curve-getParamAtPoint obj ptan))
 (setq vtr (vlax-curve-getFirstDeriv obj pam));;obtengo el vector de la tangente
 (setq ang (angle '(0 0 0) vtr)); angulo recta
 ;;(setq ref (getvar "osmode"));almacena valor inicial de osmode
 ;;(command "_osnap"  "_end,_nea");establece nuevos refent
 ;;(setvar "osmode" ref);restablece valores iniciales de osmode
 (setq pt4 (getpoint "\nSelect arc endpoint: "))
 (command "_arc" ptan "_e" pt4 "_d" (/ (* 180.0 ang) pi))
 (initget 6 "Y N")
 (if (null (setq resp (getkword "\nIs arc oriented correctly? (Y/N)<Y>:" )))
     (setq resp "Y")
 )
 (while (/= resp "Y")
  (setq ang (+ ang  pi))
  (command "_erase" "_l" "")
  (command "_arc" ptan "_e" pt4 "_d"  (/ (* 180.0 ang) pi))
  (initget 6 "Si No")
  (if (null (setq resp (getkword "\nIs arc oriented correctly? (Y/N)<Y>:" )))
     (setq resp "Y")
  )
 );end while
 )

(vl-load-com)
(setq oAcad (vlax-get-acad-object)
oDoc (vla-get-activedocument oAcad)
)
(setq pickobj (entsel "\nPick arc 1 :"))
(setq obj1 (vlax-ename->vla-object (car pickobj)))
(setq pickpt1 (cadr pickobj))
(setq cenpt1 (vla-get-center obj1)) ; returns variant center pt
(setq rad1 (vla-get-radius obj1))   ; returns rad
(setq pickobj (entsel "\nPick arc 2 :"))
(setq obj2 (vlax-ename->vla-object (car pickobj)))
(setq pickpt2 (cadr pickobj))
(setq cenpt2 (vla-get-center obj2) )
(setq rad2 (vla-get-radius obj2))
(setq newrad (getreal "\nEnter radius of extra arc " ))
(setq rad3 (+ rad1 newrad))
(setq rad4 (+ rad2 newrad))
(setq CircleObject (vla-addCircle
(vla-get-ModelSpace oDoc)
cenpt1 rad4 )
)
;(command "Circle" cenpt1 rad4) 
(setq obj3 (vlax-ename->vla-object (entlast)))
(setq CircleObject (vla-addCircle
(vla-get-ModelSpace oDoc)
cenpt2 rad3                           
)
)
;(command "Circle" cenpt2 rad3)
(setq obj4 (vlax-ename->vla-object (entlast)))
(setq intpt1 (vlax-invoke obj4 'intersectWith obj3 acExtendThisEntity)) ; returns two soloutions
;(entdel obj4)
;(entdel obj3)
(setq xy1 (list (nth 0 intpt1)(nth 1 intpt1)))
(setq xy2 (list (nth 3 intpt1)(nth 4 intpt1)))
(command "Line" xy1 xy2 "")
(command "line" cenpt1 cenpt2 xy1 cenpt1 "")
(command "line" cenpt1 cenpt2 xy2 cenpt1 "")
(princ)