圆角替换所有半径
我现在正在做一个例程，用另一个半径替换某个图层上每个多段线的半径。例如，假设由于某种原因，项目上的所有2个“半径现在需要变成3”（这发生在停车场项目上）。我最关心的是，如何使函数迭代一条多段线的所有线段，看看它是否有一个特定的半径，然后用另一个半径交换该半径，同时确保绘制的新半径与相邻的两个线段相切。如果不能画出与相邻的两个相切的圆，那么只需要在那里出现一个圆，这样用户就可以去检查他或她想要做什么。到目前为止，我得到的是(defun c:filletreplace (/ *error* ent ent8)
(defun *error* (msg)
(if (not
(member msg '("Function cancelled" "quit / exit abort"))
)
(princ (strcat "\nError: " msg))
)
(princ)
)
(setq prd (lambda (x) (eq "LWPOLYLINE" (cdr (assoc 0 (entget (car x)))))))
(if (and
(setq ent
(car (LM:SelectIf "\nSelect polyline on layer you want to replace radii: " prd entsel nil)
)
)
(filletreplace:settings)
)
(progn
(setq ent8 (cdr (assoc 8 (entget ent)))
cnt0
)
(setq ss (ssget "_A"
(list '(0 . "LWPOLYLINE")
(cons 8 ent8)
)
)
)
(repeat (sslength ss)
;;;I am getting stuck here on iterating over the polyline and checking the radius
(setq cnt (+ cnt 1))
)
)
)
)
(princ)
)
;;;
(defun filletreplace:settings ()
(setq *filletorigans*
(cond
(
(getreal
(strcat "\nOriginal radii <"
(rtos *filletorigans* 2 2)
">: "
)
)
)
(*filletorigans*)
)
)
(setq *filletreplans*
(cond
(
(getreal
(strcat "\nReplacement radii <"
(rtos *filletreplans* 2 2)
">: "
)
)
)
(*filletreplans*)
)
)
)
;;;
;;---------------------=={ Select if }==----------------------;;
;; ;;
;;Provides continuous selection prompts until either a ;;
;;predicate function is validated or a keyword is supplied. ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;msg- prompt string ;;
;;pred - optional predicate function ;;
;;func - selection function to invoke ;;
;;keyw - optional initget argument list ;;
;;------------------------------------------------------------;;
;;Returns:Entity selection list, keyword, or nil ;;
;;------------------------------------------------------------;;
(defun LM:SelectIf (msg pred func keyw / sel)
(setq pred (eval pred))
(while
(progn (setvar 'ERRNO 0)
(if keyw
(apply 'initget keyw)
)
(setq sel (func msg))
(cond
((= 7 (getvar 'ERRNO))
(princ "\nMissed, Try again.")
)
((eq 'STR (type sel))
nil
)
((vl-consp sel)
(if (and pred (not (pred sel)))
(princ "\nInvalid Object Selected.")
)
)
)
)
)
sel
) 这是Alan JT很久以前做的，非常接近您想要的，它通过拖动实时工作，但您应该能够硬编码半径。此外，在pline中，弧被称为凸出。请看lee mac pline info lisp。
(defun c:DyF (/ *error* _pnt AT:GetSel vl ov ent plst elst gr sp)
;; Dynamic Fillet
;; Alan J. Thompson, 03.07.11 / 03.09.11
(vl-load-com)
(defun *error* (msg)
(redraw)
(and vl (mapcar (function setvar) vl ov))
(and elst (mapcar (function redraw) elst '(4 4)))
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
(princ (strcat "\nError: " msg))
)
)
(defun _pnt (p) (trans (list (car p) (cadr p)) 0 1))
(defun AT:GetSel (meth msg fnc / ent)
;; meth - selection method (entsel, nentsel, nentselp)
;; msg - message to display (nil for default)
;; fnc - optional function to apply to selected object
;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
;; Alan J. Thompson, 05.25.10
(setvar 'ERRNO 0)
(while
(progn (setq ent (meth (cond (msg)
("\nSelect object: ")
)
)
)
(cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
((eq (type (car ent)) 'ENAME)
(if (and fnc (not (fnc ent)))
(princ "\nInvalid object!")
)
)
)
)
)
ent
)
(if (setq ent
(car
(AT:GetSel
entsel
"\nSelect arc: "
(lambda (x)
(if (eq "ARC" (cdr (assoc 0 (entget (car x)))))
(vl-every (function (lambda (p / ss)
(if (setq ss (ssget "_C" p p '((0 . "LINE"))))
(setq elst (cons (ssname ss 0) elst))
)
)
)
(setq plst (list (_pnt (vlax-curve-getStartPoint (car x)))
(_pnt (vlax-curve-getEndPoint (car x)))
)
)
)
)
)
)
)
)
(progn
(setq ov (mapcar (function getvar) (setq vl '("CMDECHO" "FILLETRAD"))))
(while
(progn
(setq gr (grread T 15 0))
(cond
((eq 5 (car gr))
(redraw)
(grdraw (setq sp (trans (vlax-curve-getStartPoint ent) 0 1)) (cadr gr) 1 -1)
(princ
(strcat "\rFillet radius: "
(rtos (setvar 'FILLETRAD (distance sp (cadr gr))))
" "
)
)
(if (vl-cmdf "_.fillet" (list (car elst) (car plst)) (list (cadr elst) (cadr plst)))
(progn (entdel ent) (setq ent (entlast)))
T
)
)
)
)
)
)
)
(*error* nil)
(princ)
)
谢谢比格尔的帮助！这看起来是一个很好的起点，所以我将开始处理它。 不，谢谢艾伦·J·T。 事实上，你们都在帮助这里的人方面发挥了作用。
页:
[1]