倒角尺寸，有问题乐筑天下 - Powered by Discuz! Archiver

lucas3 发表于 2022-7-5 23:47:02

倒角尺寸，有问题

我的朋友帮我写了一个代码：
(defun c:test (/ x1 x2 y1 y2 points point1 point2 point_1 point_2)
   ;Get PL vertex
   (setq points '())
(setq entselect (entsel))
   (setq entname (car entselect))
(setq select_point (cadr entselect))
(setq x (car select_point) y (cadr select_point))
(setq ent (entget entname))
   (if (equal(cdr (assoc 0 ent))"LINE" )
   (progn
(setq point_1 (cdr (assoc 10 ent)) point_2 (cdr (assoc 11 ent)))
(setq x1 (car point_1) y1 (cadr point_1) x2 (car point_2) y2 (cadr point_2))
(setq le_point (list (* 0.5 (+ x1 x2)) (* 0.5 (+ y1 y2)) ))
)

(progn
(mapcar '(lambda (x)(cond
                                 ((= 10 (car x))(setq points (cons (cdr x) points)) )
                        )
      )
ent
)
(setq add_point (car points))
(setq points (reverse points))
(setq points (cons add_point points))
(setq points (reverse points))

(princ 'lyt)
;Get chamfer vertex marked
(setq judgement 1)
(while judgement
      (setq point1 (car points))
   (setq point2 (cadr 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))))
         (progn
(setq point_1 point1 point_2 point2 judgement 'nil)
)
   )

   (setq points (cdr points))
)
(setq x1 (car point_1) y1 (cadr point_1) x2 (car point_2) y2 (cadr point_2))
(setq le_point (list (* 0.5 (+ x1 x2)) (* 0.5 (+ y1 y2)) ))

)
)

;Calc & dim
(setq choice1 (abs (- y1 y2)) )
(setq choice2 (abs (- x1 x2)) )
(if (= choice1 choice2)
   (setq choice (strcat "C" (rtos choice1 2 1)))
(setq choice (strcat(rtos choice1 2 1) "x" (rtos choice2 2 1)))
)
(setq height 2.5) ;Change test height
(command "qleader" le_point pause pause)
(setq ent (entget (entlast)))
(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))))
   (princ point)
            (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
               )
            )
   )
)

)

该代码有以下问题：
1.必须运行“qleader”，将“comment type”设置为“none”
2.dim值位于导线后面，而不是导线顶部
3.应添加“设置文字高度”并使tim层变暗
4.如果图形不是水平或垂直的，那么dim将是错误的，请查看照片

正确的方法是：1选择倒角边，2选择一个参考，3选择另一个参考边，看照片：

lucas3 发表于 2022-7-5 23:54:02

大家好，回答一下，好吗谢谢

pBe 发表于 2022-7-6 00:01:36

有趣的

...... moved to post #6 ...

lucas3 发表于 2022-7-6 00:07:36

这种做法不支持线路，只支持pl

LanloyLisp 发表于 2022-7-6 00:13:17

该代码有以下问题：
1.必须运行“qleader”，将“comment type”设置为“none”
解决方案：将qleader更改为leader（命令“leader”le\u point pause pause“”“n”）
#2和#3我不清楚
#4.这是一个乏味的编码。。

pBe 发表于 2022-7-6 00:17:21

线实体更容易编码。

代码已更新

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

是否希望代码同时适用于PLINE和LINE图元？
代码已更新

嗯，不是真的

lucas3 发表于 2022-7-6 00:22:14

很好！但我两者都想要！，非常感谢pBe！我真的很感谢你的帮助

lucas3 发表于 2022-7-6 00:25:59

主人在哪里？请帮帮我！

LanloyLisp 发表于 2022-7-6 00:33:35

我只是想让每个人都充满动力。

lucas3 发表于 2022-7-6 00:40:20

哈！你是对的！

页: [1] 2

乐筑天下's Archiver

倒角尺寸，有问题