社区 › Auto Lisp › 尺寸断开连接

andy_lee 发表于 2022-7-5 22:27:21

尺寸断开连接

这是需求的影响：

 
但是，现实是这样的：

 
也希望这样：

 
大家好！我需要帮助！
 
(vl-load-com)
(defun c:test (/ n x ent entL p2 p3 px1 px2 py1 py2 ptdd xl sa pt0 ppt ptdd)
(setvar "cmdecho" 0)
(command "undo" "be")
(setq entL '())
(if (setq ent (centsel "\nChoose Dimension or <EXIT>:" "DIMENSION"))
(progn
    (setq x (entget ent)
       entL (cons ent entL)
         p2 (dxf 13 x)
         p3 (dxf 14 x)
         px1 (list (car p2) (/ (+ (cadr p2)(cadr p3)) 2.0))
         px2 (list (car p3) (/ (+ (cadr p2)(cadr p3)) 2.0))
         py1 (list (/ (+ (car p2)(car p3)) 2.0) (cadr p2))
         py2 (list (/ (+ (car p2)(car p3)) 2.0) (cadr p3))
         ptdd (list p2 p3)
         XL (entget (dxf -2 (tblsearch "block" (dxf 2 x))))
         SA (abs (sin (angle (dxf 10 xl) (dxf 11 xl)))))
(while (setq pt0 (getpoint "\nPick point or <EXIT>:"))
      (command ".copy" ent "" "0,0" "@")
      (setq entL (cons (entlast) entL))
   (cond
   ((equal SA 1 1e-6) ;;horizonta
      (setq ptdd (cons (ptper pt0 px1 px2) ptdd)
                ppt (Lsort ptdd 0))
       )
   ((equal SA 0 1e-6) ;;vertical
      (setq ptdd (cons (ptper pt0 py1 py2) ptdd)
               ppt (Lsort ptdd 1))
      )
      (t (setq ptdd (cons (ptper pt0 p2 p3) ptdd)
         ppt (Lsort ptdd 2)))
   )
      (setq ppL (mapcar 'list ppt (cdr ppt))
             n 0)
      (repeat (length ppL)
          (setq xf (entget (nth n entL))
               nxf (subst (cons 13 (car(nth n ppL)))(assoc 13 xf) xf)
               wxf (subst (cons 14 (cadr (nth n ppL)))(assoc 14 nxf) nxf)
               n (1+ n))
          (entmod wxf)
      )
    ))
(princ "\nEXIT")
)
(command "undo" "e") (setvar "cmdecho" 1)
(princ)
)
(defun centsel (msg f)
(while (if (setq el (car (entsel msg))) (if (= (cdr (assoc 0 (entget el))) f) nil t) nil)) el
)
;;dxf
(defun dxf (x e)(cdr (assoc x e)))
;;pedal
(defun ptper (pt0 pt1 pt2)
(inters pt0 (polar pt0 (+ (angle pt1 pt2) (/ pi 2)) 1.0) pt1 pt2 nil)
)
;;sorting0 horizonta 1 vertical 2 Oblique
(defun Lsort (LT i)
(cond
((or (= i 0)(= i 2))(setq Lt (vl-sort LT (function (lambda (e1 e2)(< (car e1) (car e2)))))))
((or (= i 1)(= i 2))(setq Lt (vl-sort LT (function (lambda (e1 e2)(< (cadr e1) (cadr e2)))))))
))
(princ)

BIGAL 发表于 2022-7-5 22:34:00

我没有运行代码，但可能有一种不同的方法，采用两个版本HOR&VER，选择stpt next endpt，然后为中间DIM和最终顶层的调整级别选择一个点。所以你们有一个pt列表，你们知道第一个和最后一个，然后运行dim命令，只使用一个循环作为开始和结束点。这样可以在移动时绘制DIM，而不是进行调整。

7o7 发表于 2022-7-5 22:38:31

您更改此段落：

(cond
((equal SA 1 1e-6)
   ;;horizonta
   (setq ptdd (cons pt0 ptdd)
       ppt(Lsort ptdd 0)
   )
)
((equal SA 0 1e-6)
   ;;vertical
   (setq ptdd (cons pt0 ptdd)
       ppt(Lsort ptdd 1)
   )
)
(t
   (setq ptdd (cons pt0 ptdd)
       ppt(Lsort ptdd 2)
   )
)
)

andy_lee 发表于 2022-7-5 22:45:39

 
好啊谢谢你，先生。
但是，维度变得越来越高和越来越低。
 

7o7 发表于 2022-7-5 22:48:26

这取决于你的风格设置。你能用dimstyles上传你的文件吗？

andy_lee 发表于 2022-7-5 22:53:23

 
尊敬的先生：
谢谢，dimstyles是默认设置。我使用新文档。
测验图纸

7o7 发表于 2022-7-5 22:58:27

您还必须更改此段落：

(setq ppL (mapcar 'list ppt (cdr ppt))             
      n          0
      tt10 (cdr (assoc 10 (entget (nth n entL))))
)
(repeat        (length ppL)
(setq        xf(entget (nth n entL))
        nxf (subst (cons 13 (car (nth n ppL))) (assoc 13 xf) xf)
        wxf (subst (cons 14 (cadr (nth n ppL))) (assoc 14 nxf) nxf)
        wxf (subst (cons 10 tt10) (assoc 10 wxf) wxf)
        n   (1+ n)
)
(entmod wxf)
)

Tharwat 发表于 2022-7-5 23:03:29

使用命令：dimcontinue

andy_lee 发表于 2022-7-5 23:09:36

 
尊敬的先生：。
我真的很感谢你的帮助。我测试过了。非常好！敬佩你！
这是另一个维度合并，多个合并为一个。
但需要尺寸对齐一条线，否则，无法合并。
如下图所示。
第一种情况可以合并。
第二种情况无法合并，因为维度未对齐。

 
如果不对齐，还可以合并。
(defun c:test( / ss ic xic aa bb n ent1)
(setvar "cmdecho" 0)
(command "undo" "be")
(princ "\nPlease choose dimension for merge ")
(setq ss (ssget '((0 . "DIMENSION")))
   sumn (sslength ss) n 0 xss '() aa '())
(repeat sumn (setq xss (cons (ssname ss n) xss) n (1+ n)))
(while (car xss)
(setq bb '()
       bb (cons (car xss) bb)
       ic (getxx (entget (car xss)))
       xss (cdr xss)
       yss xss)
(while (car yss)
   (setq ent1 (car yss)
          xic (getxx (entget ent1)))
    (if (apply 'and (mapcar '(lambda(x y)(equal x y 1e-5)) xic ic))
      (setq bb (cons ent1 bb)
             xss (vl-remove ent1 xss)))
      (setq yss (cdr yss)))
(setq aa (cons bb aa))
)
(setq n 0)
(repeat (length aa)
(setq ent1 (nth n aa) n (1+ n))
(if (cdr ent1)(progn
   (setq ptx (getmxy ent1)
         xf (entget (car ent1))
      nxf (subst (cons 13 (carptx))(assoc 13 xf) xf)
      wxf (subst (cons 14 (cadr ptx))(assoc 14 nxf) nxf)
         xx (cdr ent1))
   (entmod wxf)
   (while xx (entdel (car xx)) (setq xx (cdr xx)))
))
)
(command "undo" "e") (setvar "cmdecho" 1)
(princ)
)
(defun dxf (x e)(cdr (assoc x e)))
(defun getxx(x / xy xl a b bb)
(setq xy (dxf 10 x)
   xl (entget (dxf -2 (tblsearch "block" (dxf 2 x))))
      A (angle (dxf 10 xl) (dxf 11 xl)))
(cond
((equal (abs (sin A)) 1 1e-6) ;;horizonta
   (list (cadr xy) (sin A)))
((equal (sin A) 0 1e-6) ;;vertical
   (list (car xy) (sin A)))
(t (setq B (+ A (* 0.5 pi))
          bb (- (cadr xy) (* (/ (sin B)(cos B)) (car xy))))
   (list bb (sin A)))
)
)
(defun getmxy(ssent / ptx xx yy A xl sa)
(foreach x ssent
   (setq ptx (cons (dxf 13 (entget x)) ptx)
         ptx (cons (dxf 14 (entget x)) ptx)))
(setq xl (entget (dxf -2 (tblsearch "block" (dxf 2 (entget (car ssent))))))
      A (angle (dxf 10 xl) (dxf 11 xl)))
(cond
   ((equal SA 1 1e-6) (setq ppt (Lsort ptx 0)))
   ((equal SA 0 1e-6) (setq ppt (Lsort ptx 1)))
      (t (setq ppt (Lsort ptx 2)))
)(list (car ppt)(last ppt))
)
(defun Lsort (LT i)
(cond
((or (= i 0)(= i 2))(setq Lt (vl-sort LT (function (lambda (e1 e2)(< (car e1) (car e2)))))))
((or (= i 1)(= i 2))(setq Lt (vl-sort LT (function (lambda (e1 e2)(< (cadr e1) (cadr e2)))))))
))
(princ)

andy_lee 发表于 2022-7-5 23:15:11

 
亲爱的Tharwat。非常感谢。我知道“继续”

查看完整版本: 尺寸断开连接