Topic: Chamfering code！Thanks for any help！

[flyfox1047]

Code: [Select]

(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   (car  points))
    (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))
          )

Above is my code,Always feel is not perfect！more pick...

This code by pBe ,I Feel Fine ，Part of the calculation of chamfer

Code: [Select]

(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)
          )
I want to dynamic drag and drop，like DILEADER:

I know that "DILEADER'' , Very complicated code，capacity-constrained！I hope someone could help me to finish it with pBe's code.

[ronjonp]

Here is a simple example to give you some ideas.

Code: [Select]

(defun c:foo (/ _activespace e gr ml p1 p2)
  (defun _activespace (/ doc)
    (setq doc (vla-get-activedocument (vlax-get-acad-object)))
    (if (= (getvar 'cvport) 1)
      (vla-get-paperspace doc)
      (vla-get-modelspace doc)
    )
  )
  (if
    (and (setq e (car (entsel)))
(wcmatch (cdr (assoc 0 (entget e))) "LWPOLYLINE,LINE")
(setq ml (vlax-invoke (_activespace) 'addmleader (append '(0. 0. 0.) (getvar 'viewctr)) 0))
    )
     (progn (vla-put-textstring ml "hello")
    (while (= 5 (car (setq gr (grread 't 13 2))))
      (redraw)
      (grdraw (setq p1 (cadr gr)) (setq p2 (vlax-curve-getclosestpointto e (cadr gr))) 2)
      (vlax-invoke ml 'setleaderlinevertices 0 (apply 'append (list p2 p1)))
    )
     )
  )
  (princ)
)

[snownut2]

ronjonp,

If you saw how this subject (identical thread) and the previous thread was going @ Cad Tutor, you would see that suggestions are not enough.....

Seems the idea of attempting to create something from others advise/suggestions is not what is being sought.

[ronjonp]

ronjonp,

If you saw how this subject (identical thread) and the previous thread was going @ Cad Tutor, you would see that suggestions are not enough.....

Seems the idea of attempting to create something from others advise/suggestions is not what is being sought.

Good to know .. I respectfully bow out .

[ribarm]

Flyfox, can't you just use "move" command after you create leader?

[flyfox1047]

Thanks my friend!, thanks !ronjonp, pBe help me to solve this problem!