需要自动栅格标签lis 乐筑天下 - Powered by Discuz! Archiver

structo 发表于 2022-7-5 15:48:45

需要自动栅格标签lis

嗨，朋友们，
我需要通过选择所有线来自动标记网格。请看一下我的绘图样本格式。

谢谢大家
线图纸

ronjonp 发表于 2022-7-5 15:57:37

我今天感觉很慷慨，所以：
*我创建了一个属性块，而不是插入单独的文本和圆圈。
(defun c:foo (/ _dxf _layout a b c d i n o p2 s sp x)
;; RJP - 11.16.2017
(defun _layout (name / o)
(if (and (setq o (cdr (assoc -1 (dictsearch (namedobjdict) "ACAD_LAYOUT"))))
(setq o (cdr (assoc -1 (dictsearch o name))))
)
(vla-get-block (vlax-ename->vla-object o))
)
)
(defun _dxf (code ename) (cond (ename (cdr (assoc code (entget ename))))))
;; This checks for metric drawings ( assuming it's set correctly)
(if (= 0 (getvar 'measurement))
(setq c 18.
d 18.
n "rjpbubble"
)
(setq c 0.24
d 0.2
n "rjpbubble_metric"
)
)
(if (null (tblobjname "block" n))
(progn (entmake (list '(0 . "BLOCK")
   '(100 . "AcDbEntity")
   '(67 . 0)
   '(8 . "0")
   '(100 . "AcDbBlockReference")
   '(66 . 1)
   (cons 2 n)
   '(10 0. 0. 0.)
   '(70 . 2)
   )
)
(entmake (list '(0 . "CIRCLE")
   '(100 . "AcDbEntity")
   '(67 . 0)
   '(62 . 53)
   '(8 . "grid-circle")
   '(100 . "AcDbCircle")
   '(10 0. 0. 0.)
   ;; This is the radius
   (cons 40 c)
   )
)
(entmake (list '(0 . "ATTDEF")
   '(100 . "AcDbEntity")
   '(67 . 0)
   '(62 . 121)
   '(8 . "Grid Text")
   '(100 . "AcDbText")
   '(10 -6.9925 -9. 0.)
   ;; Text height
   (cons 40 d)
   '(1 . "-")
   '(50 . 0.)
   '(41 . 1.)
   '(51 . 0.)
   (cons 7
(if (tblsearch "style" "LA-grid")
   "LA-grid"
   "Standard"
)
   )
   '(71 . 0)
   '(72 . 1)
   '(11 0. 0. 0.)
   '(100 . "AcDbAttributeDefinition")
   '(280 . 0)
   '(3 . "Number")
   '(2 . "#")
   '(70 . 0)
   '(73 . 0)
   '(74 . 2)
   '(280 . 1)
   )
)
(entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
)
)
(if (tblobjname "block" n)
(if (and (setq s (ssget '((0 . "line"))))
(setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
(setq sp (_layout (_dxf 410 (car s))))
(setq s (apply 'append (mapcar '(lambda (x) (list (_dxf 10 x) (_dxf 11 x))) s)))
(setq a (apply 'min (mapcar 'car s)))
(setq b (apply 'max (mapcar 'cadr s)))
)
(progn (setq i 0)
(foreach p (vl-sort (vl-remove-if-not '(lambda (x) (equal a (car x) 1e-) s)
'(lambda (a b) (> (cadr a) (cadr b)))
)
   (setq p2 (vlax-3d-point (list (- (car p) c) (cadr p) (caddr p))))
   (if (and (setq o (vla-insertblock sp p2 n 1 1 1 0))
(setq o (vlax-invoke o 'getattributes))
   )
(vla-put-textstring (car o) (itoa (setq i (1+ i))))
   )
)
(setq i 64)
(foreach p (vl-sort (vl-remove-if-not '(lambda (x) (equal b (cadr x) 1e-) s)
'(lambda (a b) (< (car a) (car b)))
)
   (setq p2 (vlax-3d-point (list (car p) (+ c (cadr p)) (caddr p))))
   (if (and (setq o (vla-insertblock sp p2 n 1 1 1 0))
(setq o (vlax-invoke o 'getattributes))
   )
(vla-put-textstring
   (car o)
   (if (= 91 (1+ i))
      (chr (setq i 65))
      (chr (setq i (1+ i)))
   )
)
   )
)
)
)
(print "Block could not be created .. bye...")
)
(princ)
)
(vl-load-com)

Grrr 发表于 2022-7-5 16:02:56

很酷，罗恩！

ronjonp 发表于 2022-7-5 16:07:28

谢谢

Grrr 发表于 2022-7-5 16:14:13

顺便说一句，你的entmaking块提醒我，我想完成一个通用的entmake插入，所以它是：

; (VanillaINSERT (getpoint) "VLD_Tag" (getvar 'ctab))
(defun VanillaINSERT ( p nm spc / GetBlkAttDefProps atts r )
; '(87 114 105 116 116 101 110 32 66 121 32 71 114 114 114)
(setq GetBlkAttDefProps
(lambda ( bnm / e enx typ L )
(and
   (setq e (tblobjname "BLOCK" bnm))
   (= 2 (logand 2 (cdr (assoc 70 (setq enx (entget e))))))
   (setq e (cdr (assoc -2 enx)))
   (while (and e (setq enx (entget e)) (/= "SEQEND" (setq typ (cdr (assoc 0 enx)))))
      (if (= "ATTDEF" typ) (setq L (cons (vl-remove-if-not (function (lambda (x) (member (car x) '(1 2 3 7 10 11 40)))) enx) L)))
      (setq e (entnext e))
   ); while
); and
(reverse L)
); lambda
); setq GetBlkAttDefProps

(cond
( (tblsearch "BLOCK" nm) (setq atts (GetBlkAttDefProps nm))
(if
   (setq r
      (mapcar 'entmake
      (append
         (list
            (append
            '((0 . "INSERT")(100 . "AcDbEntity")(67 . 0)) (list (cons 410 spc)) (list (cons 8 (getvar 'clayer))) '((100 . "AcDbBlockReference"))
            (list (cons 66 (if atts 1 0)) (cons 2 nm) (cons 10 p))
            '((41 . 1.)(42 . 1.)(43 . 1.)(50 . 0.0)(70 . 0)(71 . 0)(44 . 0.0)(45 . 0.0)(210 0.0 0.0 1.0))
            ); append
         ); list
         (if atts
            (mapcar
            (function
               (lambda (x / pt10 pt11 )
                  (setq pt10 (mapcar '+ p (cdr (assoc 10 x))))
                  (setq pt11 (mapcar '+ p (cdr (assoc 11 x))))
                  (append
                  '((0 . "ATTRIB")(100 . "AcDbEntity")(67 . 0))
                  (list (cons 410 spc))
                  '((8 . "0"))
                  '((100 . "AcDbText"))
                  (list (cons 10 pt10))
                  (list (assoc 40 x))
                  (list (assoc 1 x))
                  '((50 . 0.0)(41 . 1.0)(51 . 0.0))
                  (list (cons 7 (cond ((cdr (assoc 7 x))) ("Standard"))))
                  '((71 . 0)(72 . 1))
                  (list (cons 11 pt11))
                  '((210 0.0 0.0 1.0)(100 . "AcDbAttribute")(280 . 0)) (list (assoc 2 x)) '((70 . 0)(73 . 0)(74 . 2)(280 . 1))
                  ); append
               ); lambda (x)
            ); function
            atts
            ); mapcar
         ); if atts
         (list (append '((0 . "SEQEND")(100 . "AcDbEntity")(67 . 0)) (list (cons 410 spc)) '((8 . "0")) ))
      ); append
      ); mapcar
   ); setq r
   ( (lambda ( c / ) (setvar 'cmdecho 0) (if acet-attsync (acet-attsync nm) (vl-cmdf "_.ATTSYNC" "_N" nm)) (setvar 'cmdecho c)) (getvar 'cmdecho) )
); if
r
); (tblsearch "BLOCK" nm)
); cond
); defun VanillaINSERT

对于没有activex的人来说可能很方便。

devitg 发表于 2022-7-5 16:20:38

OP dwg在上部水平线上有2条线

structo 发表于 2022-7-5 16:25:48

很好的东西，罗恩·琼普。谢谢你的准备。毫无疑问，如果我将圆半径更改为“0.24”，将文字高度更改为“0.2”（用于“米单位”绘图），如何编辑代码？请引导我：）

非常感谢。

structo 发表于 2022-7-5 16:33:22

是啊抱歉。。已上载更正的文件

ronjonp 发表于 2022-7-5 16:43:13

干得好！

ronjonp 发表于 2022-7-5 16:45:25

更新了上述代码。。假设测量变量设置正确，将正确缩放。

页: [1] 2

乐筑天下's Archiver

需要自动栅格标签lis