求完善下高版本CAD的QDIM命令

marting · 发表于 2016-5-5 17:22:13

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 marting 于 2016-5-5 17:43 编辑

如图是2015下的QDIM命令，但是箭头位置的标注明显是不符合习惯的，能不能功能也想QDIM一样，但是把这种遮挡在后面的DIM不标呢？

搜狗截图20160505171508.png

csharp · 发表于 2016-5-5 19:13:20

没看到 DIM 啊

marting · 发表于 2016-5-5 19:58:41

csharp 发表于 2016-5-5 19:13
没看到 DIM 啊

拖动时候看不到DIM的，所以截图看不到，画出来就是这样的，中间第二个标注应该不要的。你试试红色的图形用QDIM标注下。

iLisp · 发表于 2016-5-5 20:25:44

marting 发表于 2016-5-5 19:58
拖动时候看不到DIM的，所以截图看不到，画出来就是这样的，中间第二个标注应该不要的。你试试红色的 ...

低版本的qdim没有中间的？
每日插件中有个三视图节点投影，类似吧，所有实体的stretchpoint 到线投影交点

marting · 发表于 2016-5-5 22:24:16

iLisp 发表于 2016-5-5 20:25
低版本的qdim没有中间的？
每日插件中有个三视图节点投影，类似吧，所有实体的stretchpoint 到线投影交 ...

我们的CAD版本最低是2012，没用过再低的，不知道低版本什么样。大师能不能写一个，以前看过的类似的帖子的都是不能过滤掉应该遮挡在后面不标注的。

csharp · 发表于 2016-5-6 00:24:32

本帖最后由 csharp 于 2016-5-6 01:08 编辑

适合封闭 lwPolyline

(defun polylines:project (ss p1 p2 / polyline:project lst retlst)
(defun polyline:project (cv p1 p2 / v lst vl start end mid i retlst)
(setq v (mapcar '- p2 p1)
i -1
lst (mapcar '(lambda (x / vv)
(setq vv (trans (mapcar '- x p1) 0 v))
(list (car vv) (last vv) (setq i (1+ i)))
)
(xdrx_entity_getstretchpoint cv)
)
vl (vl-sort lst '(lambda (l1 l2) (< (cadr l1) (cadr l2))))
start (car vl)
end (last vl)
mid (car (vl-sort lst '(lambda (l1 l2) (< (car l1) (car l2)))))
lst (mapcar '(lambda (x / p)
(setq p (xdrx_curve_getpointatparam cv x))
(list (distance p p1) p)
)
(xd::geom:numdiv
(caddr start)
(caddr end)
(list (xdrx_polyline_numverts cv) 1.0)
)
)
)
(foreach x lst
(if retlst
(cond
((> (car x) (caar retlst))
(setq retlst (cons x retlst))
)
((< (car x) (caar retlst))
(setq retlst (cons x (cdr retlst)))
)
(t)
)
(setq retlst (cons x retlst))
)
)
(reverse retlst)
)
(setq lst (mapcar '(lambda (x) (polyline:project x p1 p2))
(xdrx_pickset->ents ss)
)
lst (vl-sort lst '(lambda (x1 x2) (< (caar x1) (caar x2))))
)
(foreach x lst
(foreach a x
(if retlst
(if(> (car a) (caar retlst))
(setq retlst (cons a retlst)))
(setq retlst (cons a retlst))
)
)
)
(reverse (mapcar 'cadr retlst))
)
(defun c:tt (/ ss p1 p2 pts)
(if (and (setq ss (ssget '((0 . "lwpolyline") (-4 . "&=") (70 . 1))))
(setq p1 (getpoint "\nBase point: "))
(setq p2 (getpoint p1 "\nDirection point: "))
)
(progn
(setq pts (polylines:project ss p1 p2)
an (angle p1 p2)
)
(mapcar '(lambda (x y)
(xdrx_dimension_makerotate x y p1 an)
)
pts
(cdr pts)
)
)
)
(princ)
)

(defun polylines:project (ss p1 p2 / polyline:project lst retlst) 
  (defun polyline:project (cv p1 p2 / v lst vl start end mid i retlst) 
    (setq v        (mapcar '- p2 p1) 
          i        -1 
          lst        (mapcar        '(lambda (x / vv) 
                           (setq vv (trans (mapcar '- x p1) 0 v)) 
                           (list (car vv) (last vv) (setq i (1+ i))) 
                         ) 
                        (xdrx_entity_getstretchpoint cv) 
                ) 
          vl        (vl-sort lst '(lambda (l1 l2) (< (cadr l1) (cadr l2)))) 
          start        (car vl) 
          end        (last vl) 
          mid        (car (vl-sort lst '(lambda (l1 l2) (< (car l1) (car l2))))) 
          lst        (mapcar        '(lambda (x / p) 
                           (setq p (xdrx_curve_getpointatparam cv x)) 
                           (list (distance p p1) p) 
                         ) 
                        (xd::geom:numdiv 
                          (caddr start) 
                          (caddr end) 
                          (list (xdrx_polyline_numverts cv) 1.0) 
                        ) 
                ) 
    ) 
    (foreach x lst 
      (if retlst 
        (cond 
          ((> (car x) (caar retlst)) 
           (setq retlst (cons x retlst)) 
          ) 
          ((< (car x) (caar retlst)) 
           (setq retlst (cons x (cdr retlst))) 
          ) 
          (t) 
        ) 
        (setq retlst (cons x retlst)) 
      ) 
    ) 
    (reverse retlst) 
  ) 
  (setq        lst (mapcar '(lambda (x) (polyline:project x p1 p2)) 
                    (xdrx_pickset->ents ss) 
            ) 
        lst (vl-sort lst '(lambda (x1 x2) (< (caar x1) (caar x2)))) 
  ) 
  (foreach x lst 
    (foreach a x 
      (if retlst 
        (if(> (car a) (caar retlst)) 
           (setq retlst (cons a retlst)))           
        (setq retlst (cons a retlst)) 
      ) 
    ) 
  ) 
  (reverse (mapcar 'cadr retlst)) 
) 
(defun c:tt (/ ss p1 p2 pts) 
  (if (and (setq ss (ssget '((0 . "lwpolyline") (-4 . "&=") (70 . 1)))) 
           (setq p1 (getpoint "\nBase point: ")) 
           (setq p2 (getpoint p1 "\nDirection point: ")) 
      ) 
    (progn 
      (setq pts        (polylines:project ss p1 p2) 
            an        (angle p1 p2) 
      ) 
      (mapcar '(lambda (x y) 
                 (xdrx_dimension_makerotate x y p1 an) 
               ) 
              pts 
              (cdr pts) 
      ) 
    ) 
  ) 
  (princ) 
)

marting · 发表于 2016-5-6 08:31:19

csharp 发表于 2016-5-6 00:24
适合封闭 lwPolyline

谢谢大师，测试了下，还有点问题，帮忙看看。
1, 在WCS下

搜狗截图20160506082524.png

2. 在UCS下

csharp · 发表于 2016-5-6 23:44:44

本帖最后由 csharp 于 2016-5-6 23:58 编辑

marting 发表于 2016-5-6 08:31
谢谢大师，测试了下，还有点问题，帮忙看看。
1, 在WCS下

再试试

(defun polylines:project (ss p1 p2 / polyline:project lst retlst)
(defun polyline:project (cv p1 p2 / v lst vl start end mid i retlst an)
(setq v (mapcar '- p2 p1)
i -1
lst (mapcar '(lambda (x / vv)
(setq vv (trans (mapcar '- x p1) 0 v))
(list (setq i (1+ i)) (car vv) (last vv))
)
(xdrx_entity_getstretchpoint cv)
)
vl (vl-sort lst '(lambda (l1 l2) (< (last l1) (last l2))))
start (car vl)
end (last vl)
mid (car
(vl-sort lst
'(lambda (l1 l2) (< (abs (cadr l1)) (abs (cadr l2))))
)
)
parms (xd::geom:numdiv
(car start)
(car end)
(if (or (< (car start) (car mid) (car end))
(< (car end) (car mid) (car start))
)
1.0
(list (xdrx_polyline_numverts cv) 1.0)
)
)
)
(if (not (member (car mid) parms))
(setq parms (apply 'xd::geom:numdiv
(append (vl-sort (list (car start) (car end)) '<) '(1.0))
)
)
)
(if (not (= (car parms) (car start)))
(setq parms (reverse parms))
)
(setq lst (mapcar '(lambda (x / p)
(setq p (xdrx_curve_getpointatparam cv x))
(list (cdr (assoc x lst)) p)
)
parms
)
)
(foreach x lst
(if retlst
(progn
(while (and retlst (< (cadar x) (cadaar retlst)))
(setq retlst (cdr retlst))
)
(setq retlst (cons x retlst))
)
(setq retlst (cons x retlst))
)
)
(reverse retlst)
)
(setq lst (mapcar '(lambda (x) (polyline:project x p1 p2))
(xdrx_pickset->ents ss)
)
lst (vl-sort lst
(function (lambda (x1 x2 / l1 l2)
(setq l1 (caar x1)
l2 (caar x2)
)
(if (equal (cadr l1) (cadr l2) 0.00001)
(< (car l1) (car l2))
(< (abs (cadr l1)) (abs (cadr l2)))
)
)
)
)
)
(foreach x lst
(foreach a x
(if retlst
(progn
(while (and retlst
(< (cadar a) (cadaar retlst))
(< (abs (caar a)) (abs (caaar retlst)))
)
(setq retlst (cdr retlst))
)
(if (> (cadar a) (cadaar retlst))
(setq retlst (cons a retlst))
)
)
(setq retlst (cons a retlst))
)
)
)
(reverse (mapcar 'cadr retlst))
)
(defun c:tt (/ ss p1 p2 pts)
(if (and (setq ss (ssget '((0 . "lwpolyline") (-4 . "&=") (70 . 1))))
(setq p1 (getpoint "\nBase point: "))
(setq p2 (getpoint p1 "\nDirection point: "))
)
(progn
(setq pts (polylines:project ss (trans p1 1 0) (trans p2 1 0))
an (angle (trans p1 1 0) (trans p2 1 0))
)
(mapcar '(lambda (x y)
(xdrx_dimension_makerotate x y (trans p1 1 0) an)
)
pts
(cdr pts)
)
)
)
(princ)
)

(defun polylines:project (ss p1 p2 / polyline:project lst retlst) 
  (defun polyline:project (cv p1 p2 / v lst vl start end mid i retlst an) 
    (setq v        (mapcar '- p2 p1) 
          i        -1 
          lst        (mapcar        '(lambda (x / vv) 
                           (setq vv (trans (mapcar '- x p1) 0 v)) 
                           (list (setq i (1+ i)) (car vv) (last vv)) 
                         ) 
                        (xdrx_entity_getstretchpoint cv) 
                ) 
          vl        (vl-sort lst '(lambda (l1 l2) (< (last l1) (last l2)))) 
          start        (car vl) 
          end        (last vl) 
          mid        (car 
                  (vl-sort lst 
                           '(lambda (l1 l2) (< (abs (cadr l1)) (abs (cadr l2)))) 
                  ) 
                ) 
          parms        (xd::geom:numdiv 
                  (car start) 
                  (car end) 
                  (if (or (< (car start) (car mid) (car end)) 
                          (< (car end) (car mid) (car start)) 
                      ) 
                    1.0 
                    (list (xdrx_polyline_numverts cv) 1.0) 
                  ) 
                ) 
    ) 
    (if        (not (member (car mid) parms)) 
      (setq parms (apply 'xd::geom:numdiv 
                         (append (vl-sort (list (car start) (car end)) '<) '(1.0)) 
                  ) 
      ) 
    ) 
    (if        (not (= (car parms) (car start))) 
      (setq parms (reverse parms)) 
    ) 
    (setq lst (mapcar '(lambda (x / p) 
                         (setq p (xdrx_curve_getpointatparam cv x)) 
                         (list (cdr (assoc x lst)) p) 
                       ) 
                      parms 
              ) 
    ) 
    (foreach x lst 
      (if retlst 
        (progn 
          (while (and retlst (< (cadar x) (cadaar retlst))) 
            (setq retlst (cdr retlst)) 
          ) 
          (setq retlst (cons x retlst)) 
        ) 
        (setq retlst (cons x retlst)) 
      ) 
    ) 
    (reverse retlst) 
  ) 
  (setq        lst (mapcar '(lambda (x) (polyline:project x p1 p2)) 
                    (xdrx_pickset->ents ss) 
            ) 
        lst (vl-sort lst 
                     (function (lambda (x1 x2 / l1 l2) 
                                 (setq l1 (caar x1) 
                                       l2 (caar x2) 
                                 ) 
                                 (if (equal (cadr l1) (cadr l2) 0.00001) 
                                   (< (car l1) (car l2)) 
                                   (< (abs (cadr l1)) (abs (cadr l2))) 
                                 ) 
                               ) 
                     ) 
            ) 
  ) 
  (foreach x lst 
    (foreach a x 
      (if retlst 
        (progn 
          (while (and retlst 
                      (< (cadar a) (cadaar retlst)) 
                      (< (abs (caar a)) (abs (caaar retlst))) 
                 ) 
            (setq retlst (cdr retlst)) 
          ) 
          (if (> (cadar a) (cadaar retlst)) 
            (setq retlst (cons a retlst)) 
          ) 
        ) 
        (setq retlst (cons a retlst)) 
      ) 
    ) 
  ) 
  (reverse (mapcar 'cadr retlst)) 
) 
(defun c:tt (/ ss p1 p2 pts) 
  (if (and (setq ss (ssget '((0 . "lwpolyline") (-4 . "&=") (70 . 1)))) 
           (setq p1 (getpoint "\nBase point: ")) 
           (setq p2 (getpoint p1 "\nDirection point: ")) 
      ) 
    (progn 
      (setq pts        (polylines:project ss (trans p1 1 0) (trans p2 1 0)) 
            an        (angle (trans p1 1 0) (trans p2 1 0)) 
      ) 
      (mapcar '(lambda (x y) 
                 (xdrx_dimension_makerotate x y (trans p1 1 0) an) 
               ) 
              pts 
              (cdr pts) 
      ) 
    ) 
  ) 
  (princ) 
)

marting · 发表于 2016-5-7 13:38:28

csharp 发表于 2016-5-6 23:44
再试试

谢谢大师，基本很完美了呢，但是下面这个图形出现点瑕疵，您看看
搜狗截图20160507133338.png

marting · 发表于 2016-5-7 13:39:43

csharp 发表于 2016-5-6 23:44
再试试

另外，能否向QDIM一样，不用用户去选择起始点和方向，就平行于当前的X轴和Y轴，然后也能动态拖动，这样好实现吗？

csharp · 发表于 2016-5-8 01:10:35

marting 发表于 2016-5-7 13:39
另外，能否向QDIM一样，不用用户去选择起始点和方向，就平行于当前的X轴和Y轴，然后也能动态拖动，这样好 ...

四个方向标注，xd::entity:box 需要用修改的版本，动态后续再加

(defun xd::pnt:Quadrant (p pbox / pbox por a a1 a2 a3 a4)
(setq por (mapcar '*
'(0.5 0.5 0.0)
(mapcar '+ (car pbox) (caddr pbox))
)
a1 (angle por (caddr pbox))
a2 (angle por (last pbox))
a3 (angle por (car pbox))
a4 (angle por (cadr pbox))
a (angle por p)
)
(cond
((or (> a a4) (<= a a1)) 1)
((or (> a a1) (<= a a2)) 2)
((or (> a a2) (<= a a3)) 3)
(t 4)
)
)
(defun polylines:project (ss p1 p2 / polyline:project lst retlst)
(defun polyline:project (cv p1 p2 / v lst vl start end mid i retlst an)
(setq v (mapcar '- p2 p1)
i -1
lst (mapcar '(lambda (x / vv)
(setq vv (trans (mapcar '- x p1) 0 v))
(list (setq i (1+ i)) (car vv) (last vv))
)
(xdrx_entity_getstretchpoint cv)
)
vl (vl-sort lst '(lambda (l1 l2) (< (last l1) (last l2))))
start (car vl)
end (last vl)
mid (car
(vl-sort lst
'(lambda (l1 l2) (< (abs (cadr l1)) (abs (cadr l2))))
)
)
parms (xd::geom:numdiv
(car start)
(car end)
(if (or (< (car start) (car mid) (car end))
(< (car end) (car mid) (car start))
)
1.0
(list (xdrx_polyline_numverts cv) 1.0)
)
)
)
(if (not (member (car mid) parms))
(setq parms (apply 'xd::geom:numdiv
(append (vl-sort (list (car start) (car end)) '<) '(1.0))
)
)
)
(if (not (= (car parms) (car start)))
(setq parms (reverse parms))
)
(setq lst (mapcar '(lambda (x / p)
(setq p (xdrx_curve_getpointatparam cv x))
(list (cdr (assoc x lst)) p)
)
parms
)
)
(foreach x lst
(if retlst
(progn
(while (and retlst
(< (cadar x) (cadaar retlst))
(< (abs (caar x)) (abs (caaar retlst)))
)
(setq retlst (cdr retlst))
)
(setq retlst (cons x retlst))
)
(setq retlst (cons x retlst))
)
)
(reverse retlst)
)
(setq lst (mapcar '(lambda (x) (polyline:project x p1 p2))
(xdrx_pickset->ents ss)
)
lst (vl-sort lst
(function (lambda (x1 x2 / l1 l2)
(setq l1 (caar x1)
l2 (caar x2)
)
(if (equal (cadr l1) (cadr l2) 0.00001)
(< (car l1) (car l2))
(< (abs (cadr l1)) (abs (cadr l2)))
)
)
)
)
)
(foreach x lst
(foreach a x
(if retlst
(progn
(while (and retlst
(< (cadar a) (cadaar retlst))
(< (abs (caar a)) (abs (caaar retlst)))
)
(setq retlst (cdr retlst))
)
(if (> (cadar a) (cadaar retlst))
(setq retlst (cons a retlst))
)
)
(setq retlst (cons a retlst))
)
)
)
(reverse (mapcar 'cadr retlst))
)
(defun c:tt (/ ss pucsbox pwcsbox pbox)
(if (setq ss (ssget '((0 . "lwpolyline") (-4 . "&=") (70 . 1))))
(progn
(setq pucsbox (xd::entity:box ss)
pwcsbox (xd::pnts:ucs2wcs pucsbox)
pbox (apply 'xdrx_points_offset
(cons 100. (xd::pnts:close pwcsbox))
)
)
(mapcar
(function
(lambda (p1 p2 / pts)
(setq pts (polylines:project ss p1 p2))
(mapcar '(lambda (x y)
(xdrx_dimension_makerotate x y p1 (angle p1 p2))
)
pts
(cdr pts)
)
)
)
pbox
(cdr (xd::pnts:close pbox))
)
)
)
(princ)
)

(defun xd::pnt:Quadrant        (p pbox / pbox por a a1 a2 a3 a4) 
  (setq        por (mapcar '* 
                    '(0.5 0.5 0.0) 
                    (mapcar '+ (car pbox) (caddr pbox)) 
            ) 
        a1  (angle por (caddr pbox)) 
        a2  (angle por (last pbox)) 
        a3  (angle por (car pbox)) 
        a4  (angle por (cadr pbox)) 
        a   (angle por p) 
  ) 
  (cond 
    ((or (> a a4) (<= a a1)) 1) 
    ((or (> a a1) (<= a a2)) 2) 
    ((or (> a a2) (<= a a3)) 3) 
    (t 4) 
  ) 
) 
(defun polylines:project (ss p1 p2 / polyline:project lst retlst) 
  (defun polyline:project (cv p1 p2 / v lst vl start end mid i retlst an) 
    (setq v        (mapcar '- p2 p1) 
          i        -1 
          lst        (mapcar        '(lambda (x / vv) 
                           (setq vv (trans (mapcar '- x p1) 0 v)) 
                           (list (setq i (1+ i)) (car vv) (last vv)) 
                         ) 
                        (xdrx_entity_getstretchpoint cv) 
                ) 
          vl        (vl-sort lst '(lambda (l1 l2) (< (last l1) (last l2)))) 
          start        (car vl) 
          end        (last vl) 
          mid        (car 
                  (vl-sort lst 
                           '(lambda (l1 l2) (< (abs (cadr l1)) (abs (cadr l2)))) 
                  ) 
                ) 
          parms        (xd::geom:numdiv 
                  (car start) 
                  (car end) 
                  (if (or (< (car start) (car mid) (car end)) 
                          (< (car end) (car mid) (car start)) 
                      ) 
                    1.0 
                    (list (xdrx_polyline_numverts cv) 1.0) 
                  ) 
                ) 
    ) 
    (if        (not (member (car mid) parms)) 
      (setq parms (apply 'xd::geom:numdiv 
                         (append (vl-sort (list (car start) (car end)) '<) '(1.0)) 
                  ) 
      ) 
    ) 
    (if        (not (= (car parms) (car start))) 
      (setq parms (reverse parms)) 
    ) 
    (setq lst (mapcar '(lambda (x / p) 
                         (setq p (xdrx_curve_getpointatparam cv x)) 
                         (list (cdr (assoc x lst)) p) 
                       ) 
                      parms 
              ) 
    ) 
    (foreach x lst 
      (if retlst 
        (progn 
          (while (and retlst 
                      (< (cadar x) (cadaar retlst)) 
                      (< (abs (caar x)) (abs (caaar retlst))) 
                 ) 
            (setq retlst (cdr retlst)) 
          ) 
          (setq retlst (cons x retlst)) 
        ) 
        (setq retlst (cons x retlst)) 
      ) 
    ) 
    (reverse retlst) 
  ) 
  (setq        lst (mapcar '(lambda (x) (polyline:project x p1 p2)) 
                    (xdrx_pickset->ents ss) 
            ) 
        lst (vl-sort lst 
                     (function (lambda (x1 x2 / l1 l2) 
                                 (setq l1 (caar x1) 
                                       l2 (caar x2) 
                                 ) 
                                 (if (equal (cadr l1) (cadr l2) 0.00001) 
                                   (< (car l1) (car l2)) 
                                   (< (abs (cadr l1)) (abs (cadr l2))) 
                                 ) 
                               ) 
                     ) 
            ) 
  ) 
  (foreach x lst 
    (foreach a x 
      (if retlst 
        (progn 
          (while (and retlst 
                      (< (cadar a) (cadaar retlst)) 
                      (< (abs (caar a)) (abs (caaar retlst))) 
                 ) 
            (setq retlst (cdr retlst)) 
          ) 
          (if (> (cadar a) (cadaar retlst)) 
            (setq retlst (cons a retlst)) 
          ) 
        ) 
        (setq retlst (cons a retlst)) 
      ) 
    ) 
  ) 
  (reverse (mapcar 'cadr retlst)) 
) 
(defun c:tt (/ ss pucsbox pwcsbox pbox) 
  (if (setq ss (ssget '((0 . "lwpolyline") (-4 . "&=") (70 . 1)))) 
    (progn 
      (setq pucsbox (xd::entity:box ss) 
            pwcsbox (xd::pnts:ucs2wcs pucsbox) 
            pbox    (apply 'xdrx_points_offset 
                           (cons 100. (xd::pnts:close pwcsbox)) 
                    ) 
      ) 
      (mapcar 
        (function 
          (lambda (p1 p2 / pts) 
            (setq pts (polylines:project ss p1 p2)) 
            (mapcar '(lambda (x y) 
                       (xdrx_dimension_makerotate x y p1 (angle p1 p2)) 
                     ) 
                    pts 
                    (cdr pts) 
            ) 
          ) 
        ) 
        pbox 
        (cdr (xd::pnts:close pbox)) 
      ) 
    ) 
  ) 
  (princ) 
)

marting · 发表于 2016-5-17 09:08:31

csharp 发表于 2016-5-8 01:10
四个方向标注，xd::entity:box 需要用修改的版本，动态后续再加

谢谢大师，不知道现在有完善吗？

账号		自动登录	找回密码
密码			立即注册

[编程申请] 求完善下高版本CAD的QDIM命令

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

点评

评分

点评

点评

点评

点评