倒角程序，需要hel
(defun c:dj ()
(setq height 2.5)
(if (setq judge (getreal "Input text height（Default 2.5）"))
(setq height judge)
)
(setq messege (entsel))
(setq ent (entget (car messege)))
(setq select_point (cadr messege))
(if (equal (cdr (assoc 0 ent)) "LINE" )
(setq daojiao (chfd ))
(progn
(setq daojiao (reduce ent select_point))
)
)
;(princ daojiao)
(setq point_x (car (caddr daojiao)) point_y (cadr (caddr daojiao))x1 (car point_x) y1 (cadr point_x) x2 (car point_y) y2 (cadr point_y))
(setq le_point (list (* 0.5 (+ x1 x2)) (* 0.5 (+ y1 y2)) ))
(setq c1 (car daojiao) c2 (cadr daojiao))
(if (= (rtos c1 2 1) (rtos c2 2 1))
(setq c (strcat "C" (rtos c1 2 1)))
(setq c (strcat (rtos c1 2 1) "*" (rtos c2 2 1) ))
)
(princ c)
(princ le_point)
(princ height)
(bz c le_point height)
;(command "leader"le_point pause pause "" "" "n")
;(setq ent (entget (entlast)))
;(le ent c height)
)
(defun bz (txt1 p height / *error* name1 name2 name3)
(defun *error* (msg) ;
(entdel name1) (entdel name2) (if name3 (entdel name3))
(princ "err: ")(princ msg)
) ;
(setq ty (getvar "TEXTSTYLE") kd3 0)
(setq kd1 (caadr (textbox (list '(0 . "text")(cons 1 txt1)(cons 40 height)(cons 41 0.7)(cons 7 ty)))))
(setq kd2 (caadr (textbox (list '(0 . "text")(cons 1 "lyt love lhl")(cons 40 height)(cons 41 0.7)(cons 7 ty)))))
(setq kd (max kd1 kd2) kd (+ kd 50))
;(setq p (getpoint "\nSpecify the basis points:"))
(setq pd t)
(while pd
(setq gr (grread t 4 1) mode (car gr) pt (cadr gr))
(if (= kd3 0) (setq kd kd1))
(if (and (listp pt) (>= (car pt) (car p))) (progn
(setq p0 (polar pt 0 kd))
(setq p1 (polar pt 0 (/ (- kd kd1) 2)) p1 (polar p1 (angtof "90") (* 0.2 height)))
(setq p2 (polar pt 0 (/ (- kd kd2) 2)) p2 (polar p2 (angtof "270") 350)))
)
(if (and (listp pt) (< (car pt) (car p))) (progn
(setq p0 (polar pt pi kd))
(setq p1 (polar p0 0 (/ (- kd kd1) 2)) p1 (polar p1 (angtof "90") (* 0.2 height)))
(setq p2 (polar p0 0 (/ (- kd kd2) 2)) p2 (polar p2 (angtof "270") 350)))
)
(if (= mode 5) (progn
(if name1 (entdel name1))
(entmake (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")'(100 . "AcDbPolyline")'(90 . 3)
(cons 10 p)(cons 10 pt)(cons 10 p0)))
(setq name1 (entlast))
(if name2 (entdel name2))
(entmake (list '(0 . "text")(cons 1 txt1)(cons 40 height)(cons 41 0.7)(cons 10 p1)(cons 7 ty)))
(setq name2 (entlast))
(if name3 (entdel name3))
(if (= kd3 1) (entmake (list '(0 . "text")(cons 1 txt2)(cons 40 height)(cons 41 0.7)(cons 10 p2)(cons 7 ty))))
(if (= kd3 1) (setq name3 (entlast))))
)
(if (= mode 3) (setq pd nil))
(if (or (= mode 2) (= mode 25)) (progn (setq pd nil) (entdel name1) (entdel name2) (if name3 (entdel name3))))
)
)
(defun le (ent choice height)
(setq points '())
(mapcar '(lambda (x)
(cond
((= 10 (car x)) (setq points (cons (cdr x) points)))
)
)
ent
)
(setq point_end (carpoints))
(setq point_start (cadr points))
(if (> (- (car point_end) (car point_start)) 0)
(progn
(setq point (list (+ (car point_end)(* 0.7 height)) (- (cadr point_end) (* 0.5 height))))
(command "text" point height 0 choice )
)
(progn
(setq point (list (- (car point_end) (* 0.7 height) ) (- (cadr point_end) (* 0.5 height))))
(command "text" point height 0 choice )
(setq entname (entlast))
(setq ent (entget entname))
(entmod
(mapcar '(lambda ( x)
(cond
((= (car x) 72) (cons (car x)2))
((= (car x) 11) (cons (car x)point))
(t x)
)
)
ent
)
)
)
)
(setq text_point (mapcar '* (mapcar '+ point_end point_start) '(0.5 0.5 0.5)))
(setq height_modify(list 0 (* 0.2 height) 0 ) )
(setq text_point (mapcar '+text_point height_modify))
(setq ent (entget (entlast)))
(entmod
(mapcar '(lambda ( x)
(cond
((= (car x) 72) (cons (car x)1))
((= (car x) 11) (cons (car x)text_point))
(t x)
)
)
ent
)
)
)
(defun reduce (ent select_point / daojiao1 point0 point1 point2 point3 x y x1 x2 y1 y2)
(setq points '())
(setq i 1)
(setq x (car select_point) y (cadr select_point))
(mapcar '(lambda (x)(cond
((= 10 (car x))(setq points (cons (cdr x) points)) )
)
)
ent
)
(setq x (car select_point) y (cadr select_point))
(setq add_point1 (car points))
(setq add_point2 (cadr points))
(setq points (reverse points))
(setq add_point3 (car points))
(setq points (cons add_point1 points))
(setq points (cons add_point2 points))
(setq points (reverse points))
(setq points (cons add_point3 points))
(while (< i (- (length points) 2) )
(setq point1 (nth i points))
(setq point2 (nth (+ i 1) points))
(setq x1 (car point1) y1 (cadr point1) x2 (car point2) y2 (cadr point2))
(if (and (or (and (< x x1) (> x x2)) (and (< x x2) (> x x1))) (or (and (< y y1) (> y y2)) (and (< y y2) (> y y1))))
(setq j i i (length points))
)
(setq i (+ i 1))
)
(setq point0 (nth (- j 1) points) point3 (nth (+ j 2) points))
(setq default_color (getvar "cecolor"))
(command "color" 1 "")
(command "line" point0 point1 "")
(setq ent1 (entlast))
(command "line" point1 point2 "")
(setq ent2 (entlast))
(command "line" point2 point3 "")
(setq ent3 (entlast))
(setq daojiao1 (chfd))
(entdel ent1 )
(entdel ent2 )
(entdel ent3 )
(command "color" default_color "")
(setq daojiao1 daojiao1)
)
(defun chfd (/ _dxf _para _valid a typ obj p1 p2 intrpt)
(Defun _dxf (e dx) (cdr (assoc dx (entget e))))
(defun _para (o p)
(vlax-curve-getparamatpoint
o
(vlax-curve-getClosestPointTo o p )
)
)
(defun _valid (e typ / e)
(if (wcmatch (Setq v (_dxf e 0)) typ)
v))
(if (and (setq a (entsel "\nSelect Chamfered segment: "))
(Setq typ (_valid (setq obj (car a))
"LWPOLYLINE,LINE")))
(if (eq typ "LINE")
(progn
(command "change" obj "" "p" "c" 3 "")
(while (not (And
(setq obj2 (car(entsel"\nSelect another segment: ")))
(not (command "change" obj2 "" "p" "c" 3 ""))
(setq obj3 (car(entsel"\nAnd another: ")))
(not (command "change" obj3 "" "p" "c" 3 ""))
(_valid obj2 "LINE")
(_valid obj3 "LINE"))
)
)
(setq intrpt (inters (_dxf obj2 10)
(_dxf obj2 11)
(_dxf obj3 10)
(_dxf obj3 11)
nil))
(Setq p1 (_dxf obj 10) p2 (_dxf obj 11))
)
(progn
(setq prm1 (_para obj (cadr a)))
(setq pts (mapcar 'cdr
(vl-remove-if-not
'(lambda (k)
(= (car k) 10)
)
(entget obj)
)
)
)
(setq inbetween (vl-some '(lambda (j k)
(if (< (_para obj j) prm1 (_para obj k))
(list j k)
)
)
pts
(cdr pts)
)
)
(and
(setq p1 (cadr (member (car inbetween) (reverse pts))))
(setq p2 (cadr (member (Cadr inbetween) pts)))
(setq intrpt (inters p1(Car inbetween)
p2(cadr inbetween) nil)
)
(setq p1 (Car inbetween) p2 (cadr inbetween))
)
)
)(princ "\nNull/Invalid selection")
)
(if intrpt
(print (strcat "<<< "
(rtos (distance p1 intrpt) 2 2)
"x"
(rtos (distance p2 intrpt) 2 2)
" >>>"
)
)(princ "\nInvalid data")
)
(setq aa (distance p1 intrpt))
(setq bb (distance p2 intrpt))
(list aa bb (list p1 p2))
)
总是感觉不完美更多选择。。。
这是pBe的代码，我感觉很好，在这里
(defun c:chfd (/ _dxf _para _valid a typ obj p1 p2 intrpt)
(Defun _dxf (e dx) (cdr (assoc dx (entget e))))
(defun _para (o p)
(vlax-curve-getparamatpoint
o
(vlax-curve-getClosestPointTo o p)
)
)
(defun _valid (e typ / e)
(if (wcmatch (Setq v (_dxf e 0)) typ)
v))
(if (and (setq a (entsel "\nSelect Chamfered segment: "))
(Setq typ (_valid (setq obj (car a))
"LWPOLYLINE,LINE")))
(if (eq typ "LINE")
(progn
(while (not (And
(setq obj2 (car(entsel"\nSelect another segment: ")))
(setq obj3 (car(entsel"\nAnd another: ")))
(_valid obj2 "LINE")
(_valid obj3 "LINE"))
)
)
(setq intrpt (inters (_dxf obj2 10)
(_dxf obj2 11)
(_dxf obj3 10)
(_dxf obj3 11)
nil))
(Setq p1 (_dxf obj 10) p2 (_dxf obj 11))
)
(progn
(setq prm1 (_para obj (cadr a)))
(setq pts (mapcar 'cdr
(vl-remove-if-not
'(lambda (k)
(= (car k) 10)
)
(entget obj)
)
)
)
(setq inbetween (vl-some '(lambda (j k)
(if (< (_para obj j) prm1 (_para obj k))
(list j k)
)
)
pts
(cdr pts)
)
)
(and
(setq p1 (cadr (member (car inbetween) (reverse pts))))
(setq p2 (cadr (member (Cadr inbetween) pts)))
(setq intrpt (inters p1(Car inbetween)
p2(cadr inbetween) nil)
)
(setq p1 (Car inbetween) p2 (cadr inbetween))
)
)
)(princ "\nNull/Invalid selection")
)
(if intrpt
(print (strcat "<<< "
(rtos (distance p1 intrpt) 2 2)
"x"
(rtos (distance p2 intrpt) 2 2)
" >>>"
)
)(princ "\nInvalid data")
)(princ)
)
我想要动态，就像这样： flyfox，
看看安德里亚在《TheSwamp》中的《DILEADER》。组织：动态智能领导者！
ymg3，谢谢！我知道“DILEADER”，非常复杂的代码，容量有限！我希望有人能帮我用pBe的代码完成它。 有人给我一个小惊喜？？ 飞，很好！预料 我真的不明白flyflox的代码是什么？是否要在“倒角”段内“拖动”引线和文本标签？
我认为是这样！fly的代码很好！但不能“拖动”，只能从倒角边的中点绘制。
非常感谢。卢卡斯！
这就是我想要动态拖放的原因 很抱歉以前我上传的代码缺少功能，现在，已经更新了
pBe，对不起！以前我上传的代码缺少功能，现在，已经更新了
页:
[1]
2