附加的例程执行此操作，但它使用grreead方法，因此无法输入指定半径。
DTA启动
;*************************************************************
;* DTanArc.lsp (c) 2010Lloyd 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的网站上找到的一个。我只把其中3个提示改成了英语。。。
;;; CADALYST 05/08www.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 (+ angpi))
(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
)
不错的程序，但它们都要求您指定切线。我希望autocad为我做到这一点。哈哈。 有一个几何解，将所有3个弧中心连接起来，使边的三角形长度为R1+R3 R2+R2 3rd centpt centpt，我只使用ttr，可能有一天没有足够的需求来编写lisp。请注意，尽管这个问题有多达4种解决方案，但我知道我们的其他民用软件可以根据您的需要解决这个问题。
快速绘制两条弧，通过圆ttr添加第三条弧，然后添加连接所有3个中心。新弧的中心点的解决方案是rad1+newrad与rad2+newrad相交，有两个解决方案，绘制几个圆，很容易看到如何实现。现在去找时间。
快到了，但现在是一个时钟，所以也许其他人会来接
(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)
页:
1
[2]