社区 › Auto Lisp › dimensi的自动放置

drafter_joe 发表于 2022-7-5 16:45:42

dimensi的自动放置

我一直在尝试这篇文章第一页的Tharwat代码，并将其整合到我已经拥有的代码中。我使用点坐标在顶部有倒角的矩形上自动放置尺寸。我现在的问题是维度没有按我预期的那样放置。我确实在另一个论坛上找到了Tharwat的这段代码，他使用Visual LISP来放置维度。
(defun c:TesT (/ ss n sset p1 y p2 x p3)
;;;====== Tharwat 17. Sep. 2011 =====;;;
(vl-load-com)
(cond ((not spc)
      (setq spc (vla-get-ModelSpace
                  (vla-get-activedocument (vlax-get-acad-object))
                  )
      )
       )
)
(if (setq ss (ssget '((0 . "POLYLINE,LWPOLYLINE"))))
   (progn
   (if (= 4.0 (vlax-curve-getendparam (ssname ss 0)))
       (repeat (setq n (sslength ss))
         (setq sset (ssname ss (setq n (1- n))))
         (setq p1 (vlax-3d-point
                  (setq y (vlax-curve-getpointatparam sset 0))
                  )
         )
         (setq p2 (vlax-3d-point
                  (setq x (vlax-curve-getpointatparam sset 1))
                  )
         )
         (setq p3 (vlax-3d-point (vlax-curve-getpointatparam sset 2)))
         (vla-adddimrotated
         spc
         p1
         p2
         (vlax-3d-point (list (car y) (+ (cadr y) 10.) (caddr y)))
         0.0
         )
         (vla-AddDimAligned
         spc
         p2
         p3
         (vlax-3d-point (list (+ (car x) 10.) (cadr x) (caddr x)))
         )
       )
   )
   )
   (princ)
)
(princ)
)
 
我不知道如何将这段代码合并到我的代码中。如果可能的话，有人能告诉我怎么做吗？现在，我只是想让其中一个维度正确显示。
 
下图是我试图实现的目标。

以下是当前代码。
(defun SetvariableToEachCoordinate (s / e i); subroutine by Tharwat 1/13/17
(if (and (eq (type s) 'ENAME)
          (= (cdr (assoc 0 (setq e (entget s)))) "LWPOLYLINE")
          (setq i 0)
          )
   (mapcar '(lambda (x) (set (read (strcat "P" (itoa (setq i (1+ i))))) x)
            (setq l (cons (read (strcat "P" (itoa i))) l))
            )
         (mapcar 'cdr (vl-remove-if-not '(lambda (q) (= (car q) 10)) e))
         )
   )
(reverse l)
(setq lofl (length l))
)

(defun c:dimbox3 ()
(vl-load-com)
(cond        ((not spc)
(setq spc (vla-get-ModelSpace
             (vla-get-activedocument (vlax-get-acad-object))
           )
)
)
)
(setvar "cmdecho" 0)
(setq        varlist        '(a b x       q ss s i en dimdist l lst))
(foreach var varlist (set var nil))
(setq factor (getvar "dimscale"))
(if (zerop (getvar "dimtxt"))
   (setq hgt
   2.5
   )
   (setq hgt (getvar "dimtxt"))
)
(setq dimdist (* factor (* 5 hgt)))
(setq i 0)
(setq ss (ssget "_X" '((0 . "*POLYLINE") (8 . "0"))))

(repeat (setq nos (sslength ss))
   (setq lst
   (cons (SetvariableToEachCoordinate
           (ssname ss (setq nos (1- nos)))
       )
       lst
   )
   )
)                                        ;end repeat

(command "._dimlinear"
   "_non"
   p3
   "_non"
   p4
   "_non"
   (polar p3 (/ (* 0 pi) 180) dimdist)
)

(setvar "cmdecho" 1)
(princ)
)
 
非常感谢。
起草人Joe

Roy_043 发表于 2022-7-5 16:53:05

如果您想为多段线创建与示例类似的代码，那么这是可行的。但是你仍然需要分析几何学。任何一个点都可以是第一个点，多段线的方向可以是顺时针或逆时针。你不应该假设一个固定的顺序。

Lee Mac 发表于 2022-7-5 17:00:09

这将为您提供大部分帮助：
从这里顺时针列出函数。

Grrr 发表于 2022-7-5 17:01:04

嗨，李，
我越是尝试剖析/消化你的完整示例，就越能看到我忽略/遗漏的东西。
这次这个街区让我：

(setq lst
(   (lambda ( p / r )
   (append
   (vl-member-if '(lambda ( x ) (cond ((equal x p 1e-) ((setq r (cons x r)) nil))) lst)
   (reverse r)
   )
)
(apply 'mapcar (cons 'min lst))
)
)
 
(apply 'mapcar (cons 'min lst))
^^我以前见过这样的情况：
(setq cen (apply 'mapcar (cons '(lambda (a b) (/ (+ a b) 2.)) (mapcar 'vlax-safearray->list (list ll ur)))))
我敢打赌你一定认识你给我举的上述例子。
但是（应用‘mapcar（cons’min lst））不等于：（mapcar’min lst）？
或者我错过了什么？
 
显然，我在想象lambda部分时遇到了一些麻烦：

(lambda ( p / r )
(append
   (vl-member-if '(lambda ( x ) (cond ((equal x p 1e-) ((setq r (cons x r)) nil))) lst)
   (reverse r)
)
)
 
如果你不介意解释（尤其是应用“地图车”部分）
谢谢

BIGAL 发表于 2022-7-5 17:05:49

李，我和ssget有问题，我把它切回lwpolyline，然后它工作不确定我做错了什么其他人有问题吗？我必须查找所有dxf代码才能找到它。现在我的参考书在哪里。
 
一般来说，我可以看到一个问题，当你想调暗左侧时会发生什么？我考虑了这个问题，提出了一些想法，使用拾取点来定义要变暗的第一条腿，因此比较顶点来找到这个点，这也是一个问题，一旦你到达垂直列表的末尾，你需要转到列表的开头，继续计算腿数。因此，这将是选择腿和所需的段数。这可能是defun name autodim2 autodim3的一部分，因为代码的余额只需要一次。
 
可能是一个昏暗的所有腿，并用于接受任何关键拒绝。作为这项工作的一部分，检查两点的角度，因此使用垂直和水平，否则同时进行垂直和水平。

Lee Mac 发表于 2022-7-5 17:12:35

 
没有-
 
给定列表：
(setq lst '(<item1> <item2> ... <itemN>))
(mapcar 'min lst) == ((min <item1>) (min <item2>) ... (min <itemN>))
(apply 'mapcar (cons 'min lst)) == ((min (car <item1>) (car <item2>) ... (car <itemN>)) (min (cadr <item1>) (cadr <item2>) ... (cadr <itemN>)) ...)

Lee Mac 发表于 2022-7-5 17:19:14

 
ssget过滤器将只允许位于模型空间中的具有6个顶点且没有弧段的闭合多段线。

Grrr 发表于 2022-7-5 17:24:29

感谢李的解释，
我立即想到了LM:ssboundingbox子函数，并且可以创建类似的东西（不适用于插入，但希望您能得到想法/灵感）：
 

(defun VanillaBoundingBox ( SS / i enx lst )
(if (eq 'PICKSET (type SS))
   (repeat (setq i (sslength SS))
   (and (/= "INSERT" (cdr (assoc 0 (setq enx (entget (ssname SS (setq i (1- i))))))))
       (setq lst
         (append lst
         (apply 'append
             (mapcar
               (function (lambda (x) (if (member (car x) '(10 11)) (list (cdr x)))))
               enx
             ); mapcar
         ); apply 'append
         ); append lst
       ); setq
   ); and
   ); repeat
); if
(if lst (list (apply 'mapcar (cons 'min lst)) (apply 'mapcar (cons 'max lst))))
); defun VanillaBoundingBox

 
11

Lee Mac 发表于 2022-7-5 17:26:49

 
不客气。
 
 
这是一个好主意，但它将严格限于线性对象，例如直线和直线分段的LWD多段线-对于非线性对象（圆弧、圆、椭圆、样条曲线和具有圆弧段的LWD多段线），显然会得到不想要的结果，DXF组10和11不对应于定义几何体的坐标的对象（例如，文本、多行文字和插入-如您所述）。

BIGAL 发表于 2022-7-5 17:33:55

谢谢李，我有5段在我的测试线路。dxf 90不是我会想到的。

查看完整版本: dimensi的自动放置