块的动比、角
本帖最后由 尘缘一生 于 2024-9-7 23:11 编辑从画图效率上来说，放大缩小似乎补充另一种XY同步状况，
图纸的块需要这种操作时候，并不多，逐渐接近于“拉边拉伸定位”，这一要求。
;;动态图块比例-----(一级)---------
;Modify by SLdesign V3.0 尘缘一生 QQ: 15290049
(defun dyblk (blknam / plis dx0 dx dy0 dy bx by p1 p0 els0 els pt loop ang f3 f8 bb p00 k1 k2 k3 kk)
(command "_.undo" "be")
(setq p1 (dxf1 blknam 10) plis (ebox4 blknam) p0 (car plis) dx0 (distance p0 (cadr plis)) dy0 (distance p0 (cadddr plis)))
(sl-blockbaseedit blknam p0)
(setq els0 (entget blknam))
(princ (slmsg
"\n->(左右键...>退出)"
"\n->(オ龄...>癶)"
"\n-> (left and right keys...>exit)"
)
)
(setq loop t k1 t k2 t els els0 f8 (getvar "ORTHOMODE") f3 (getvar "OSMODE"))
(while loop
(setq bb (grread t 15 2) p00 (cadr bb))
(redraw)
(cond
((equal bb '(2 6));F3切换捕捉开关
(cond
((and (< f3 16384) (/= f3 0))
(setq f3 (+ f3 16384))
(prompt (slmsg "\n <对象捕捉 关>" "\n <癸禜 闽>" "\n <OSnap Off>"))
)
((or (= f3 0) (>= f3 16384))
(setq f3 16383)
(prompt (slmsg "\n <对象捕捉 开>" "\n <癸禜 秨>" "\n <OSnap On>"))
)
)
(setvar "OSMODE" f3)
)
((equal bb '(2 15)) ;F8切换正交开关
(if (= f8 0)
(progn (setq f8 1) (prompt (slmsg "\n <正交 开>" "\n <タユ 秨>" "\n <Orth open>")))
(progn (setq f8 0) (prompt (slmsg "\n <正交 关>" "\n <タユ 闽>" "\n <Orth off>")))
)
(setvar "ORTHOMODE" f8)
)
((= (car bb) 5)
(redraw)
(if (= f8 1)
(progn
(setq ang (angle p0 p00))
(cond
((or (and (> ang pi4) (< ang 3pi4)) (and (> ang 5pi4) (< ang 7pi4)))
(setq pt (list (car p0) (cadr p00)))
)
(t (setq pt (list (car p00) (cadr p0))))
)
)
(setq pt p00)
)
(if (and (<= f3 16384) (> f3 0) (/= f8 1))
(setq pt (slosnappt nil pt) kk t)
)
(grdraw p0 pt 1 3)
(cond
((and k1 (not k2))
(setq bx (dxf1 els 41) dx (abs (- (car p0) (car pt))))
(grdraw-drawjx p0 (list (car pt) (cadr (caddr plis)) 0))
(entmod (emod els 41 (* bx (/ dx dx0))))
)
((and k2 (not k1))
(setq by (dxf1 els 42) dy (abs (- (cadr p0) (cadr pt))))
(grdraw-drawjx p0 (list (car (cadr plis)) (cadr pt) 0))
(entmod (emod els 42 (* by (/ dy dy0))))
)
((and k1 k2)
(setq bx (dxf1 els 41) by (dxf1 els 42) dx (abs (- (car p0) (car pt))) dy (abs (- (cadr p0) (cadr pt))))
(grdraw-drawjx p0 pt)
(entmod (emod (emod els 41 (* bx (/ dx dx0))) 42 (* by (/ dy dy0))))
)
(k3
(setq ang (angle p0 pt))
(entmod (emod els 50 ang))
)
)
(entupd blknam)
)
((member bb '((2 9))) ;;table XY同时
(setq k1 t k2 t k3 nil els els0)
)
((member bb '((2 88) (2 120)));;定X比
(setq k1 t k2 nil k3 nil els els0)
)
((member bb '((2 89) (2 121)));;定Y比
(setq k1 nilk2 t k3 nil els els0)
)
((member bb '((2 65) (2 97))) ;;A定角
(setq k1 nilk2 nil k3 t els els0)
)
((or
(member (car bb) '(11 25)) ;;右键
(member bb '((2 13))) ;;左键
(= (car bb) 3) ;;回车
)
(setq loop nil)
)
)
)
(redraw)
(if (> (distance p0 p1) 0.001)
(sl-blockbaseedit blknam p1) ;基点恢复
)
(if kk (sl:erase (ssget "X" (list (cons 8 "f-i-n-d")))))
(command "_.undo" "e")
(princ)
)
;;测试
(defun c:tt ()
(setq blknam (car (entsel))) ;选块
(dyblk blknam)
)
哈哈，增加了自定义函数：sl-blockbaseedit、grdraw-drawjx 看起来似乎是操作矢量图，我们机械行业绝对禁止这样，只允许按固定整数比例对待DWG，一就是一。否则，CAD,CAM,CAE,都没法玩了。 本帖最后由 尘缘一生 于 2024-9-7 21:36 编辑
GEGEYANG88 发表于 2024-9-7 20:57
看起来似乎是操作矢量图，我们机械行业绝对禁止这样，只允许按固定整数比例对待DWG，一就是一。否则，CAD,C ...嗯，这个就会把块的比例搞的随意性，是一个用户要求这个功能，我才试试，准确定位这一点，还是不行，包容盒与比例的换算等等，还是考虑不周。
对于模型空间用了大量的图块情况下，在图纸空间，块的比例就会乱起来，那么，会出现炸开，数字跑的很大，或很小，。
那么，这个拉大，再炸开，可以避免文字错乱。
对于室内设计的来说，可能需要这个功能，比如：门窗块什么的，拉到位目标边界，并不需要考虑这个块变换后，比例到底多少。
我更多时候是在做固定造型不同尺寸时用来“偷懒”用的，比如固定的造型填充，xy方向不同比时。哈。。 bai2000 发表于 2024-9-8 06:48
哈哈，增加了自定义函数：sl-blockbaseedit、grdraw-drawjx
陈董的专属自定义函数
(sl-blockbaseedit blknam p1) ;基点恢复
sl:erase
grdraw-drawjx
slosnappt
dxf1
ebox4
slmsg 寒潮大冬瓜 发表于 2024-9-9 15:40
陈董的专属自定义函数
(sl-blockbaseedit blknam p1) ;基点恢复
sl:erase
我实在是没有功夫提取，应该做个了，不然，没法测试。 请楼主不要在AutoLISP/Visual LISP 编程技术区乱发伪lisp源码！
页:
[1]