*帮助*尝试匹配块s

Tharwat · 发表于 2022-7-5 16:35:08

只需反转DXF列表即可执行以下相反的任务：
替换此：


(entmod (append en1 (list (assoc 41 en2) (assoc 42 en2) (assoc 43 en2))))

有了这个：

copy


(entmod (append en2 (list (assoc 41 en1) (assoc 42 en1) (assoc 43 en1))))

marko_ribar · 发表于 2022-7-5 16:39:55

在这里，请尝试以下代码：

copy


(defun c:rescaleblkbycorners ( / blk p1 p2 ll ur minpt maxpt )
 (vl-load-com)
 (prompt "\nSelect block you want to rescale on unlocked layer...")
 (setq blk (ssname (ssget "_+.:E:S:L" '((0 . "INSERT"))) 0))
 (if blk
   (progn
     (setq p1 (getpoint "\nPick or specify corner point : "))
     (setq p2 (getcorner p1 "\nPick or specify other corner point : "))
     (setq ll (list (apply 'min (mapcar 'car (list p1 p2))) (apply 'min (mapcar 'cadr (list p1 p2)))) ur (list (apply 'max (mapcar 'car (list p1 p2))) (apply 'max (mapcar 'cadr (list p1 p2)))))
     (entupd (cdr (assoc -1 (entmod (subst (cons 41 1.0) (assoc 41 (entget blk)) (entget blk))))))
     (entupd (cdr (assoc -1 (entmod (subst (cons 42 1.0) (assoc 42 (entget blk)) (entget blk))))))
     (entupd (cdr (assoc -1 (entmod (subst (cons 43 1.0) (assoc 43 (entget blk)) (entget blk))))))
     (vla-getboundingbox (vlax-ename->vla-object blk) 'minpt 'maxpt)
     (mapcar 'set '(minpt maxpt) (mapcar 'safearray-value (list minpt maxpt)))
     (entupd (cdr (assoc -1 (entmod (subst (cons 41 (/ (- (car ur) (car ll)) (- (car maxpt) (car minpt)))) (assoc 41 (entget blk)) (entget blk))))))
     (entupd (cdr (assoc -1 (entmod (subst (cons 42 (/ (- (cadr ur) (cadr ll)) (- (cadr maxpt) (cadr minpt)))) (assoc 42 (entget blk)) (entget blk))))))
     (vla-getboundingbox (vlax-ename->vla-object blk) 'minpt 'maxpt)
     (mapcar 'set '(minpt maxpt) (mapcar 'safearray-value (list minpt maxpt)))
     (vla-move (vlax-ename->vla-object blk) (vlax-3d-point minpt) (vlax-3d-point ll))
   )
 )
 (princ)
)