社区 › AutoLISP/Visual LISP 编程技术 › 移动、复制综合集成

尘缘一生 发表于 2024-4-10 17:13:45

移动、复制综合集成

本帖最后由 尘缘一生 于 2024-4-10 22:33 编辑

这部分，任何二开都应该做好集成，不属于专业类，并且，在使用中不断的完善，放一下三领的集成代码，
这部分，可能C开发的速度更快，经过这么久的使用，矩阵也好，函数也好，这部分还不如command ，也许只有期待C了。
这三个函数，不能独立运行，如果你拿来主义，绕道吧，需三领支持测试。

链接：https://pan.baidu.com/s/185B4hyR4cnC65UBfp0CX5Q
提取码：n0vh
;;实体、选择集9点位移动到 pt定位-----(一级)----
;;pt 定位点
(defun slmov9 (ss pt / os bb ms1 ms2 loop pt0 p0 e1 ee)
(defun ssk (ss k)
    (if (= (sslength ss) 1)
      (setq pt0 (e9pt (ssname ss 0) k))
      (setq pt0 (ss9pt ss k))
    )
    pt0
)
;;------------
(setq ms1
    (strcat
      (slmsg
      "\n->定位 [左下(1)/下中(2)/右下(3)/左中(4)/正中(5)/右中(6)/左上(7)/上中(8)/右上(9)/"
      "\n->﹚ [オ(1)/い(2)/(3)/オい(4)/タい(5)/い(6)/オ(7)/い(8)/(9)/"
      "\n->Positioning [Lower left (1)/Lower middle (2)/Lower right (3)/Middle left (4)/Centering (5)/Middle right (6)/Upper left (7)/Upper middle (8)/Upper right (9)/"
      )
      (slmsg
      "逆转90度(TAB)/取角(A)/LIN.(E)/放大(Q)/缩小(W)/放大一倍(+)/缩小一半(-)](左键、右键、空格>定位)"
      "癴锣90(TAB)/à(A)/LIN.(E)/(Q)/罽(W)/(+)/罽(-)](オ龄龄>﹚)"
      "Rever90(TAB)/Takang(A)/LIN.(E)/Enlarge(Q)/Reduce(W)/Double(+)/Half(-)](Left,Right,Space>Locate)"
      )
    )
)
(setq os (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq p0 (ssk ss 5) pt0 (cadr (grread 5)) pt0 (polar pt0 (angle pt0 p0) (distance pt0 p0)))
(if (= pt nil) (setq pt pt0))
(setq ms2 (slmsg "-->当前<正中>" "-->讽玡<タい>" "-->Current<Center>"))
(princ (strcat ms1 ms2))
(setq loop T)
(while loop
    (redraw)
    (slslx pt 0)
    (setq bb (grread T 8))
    (cond
      ((or (= (car bb) 3) ;;左键
         (= (car bb) 11);;右键设置为回车时
         (= (car bb) 25);;右键设置为屏幕菜单时
         (equal bb '(2 32));;空格键
       )
      (setq loop nil)
      )
      ((member bb '((2 65) (2 97)))   ;;A 旋转定角
      (setq a (ss9pt ss 5))
      (setq b (polar a 0 500))
      (command ".rotate" ss "" "_non" a "r" "_non" a b pause)
      )
      ((member bb '((2 69) (2 101)))   ;;E e 齐线
      (setq ss (ss-rotang ss 0))
      (setq e1 (car (setq ee (entsel (slmsg "\n -->请选择要对齐的实体" "\n -->叫匡拒璶癸霍龟砰" "\n -->Please select the entity to align")))))
      (setq ang (e-ang e1 (cadr ee)))
      (setq ss (ss-rotang ss ang))
      )
      ((member bb '((2 9)))      ;;table 键
      (command "ROTATE" ss "" pt 90)
      )
      ((member bb '((2 87) (2 119)))   ;;缩小W w
      (command "scale" ss "" pt "0.9")
      )
      ((member bb '((2 81) (2 113)))   ;;放大Q q
      (command "scale" ss "" pt "1.1")
      )
      ((equal bb '(2 45))         ;;缩小一半 -
      (command "scale" ss "" pt "0.5")
      )
      ((member bb '((2 43) (2 61)));;放大一倍 +
      (command "scale" ss "" pt "2.0")
      )
      ((equal bb '(2 49));; 1键
      (setq pt0 (ssk ss 1))
      (setq ms2 (slmsg "当前<左下>" "讽玡<オ>" "Current<Bottom Left>"))
      (command "move" ss "" pt0 pt)
      (princ (strcat ms1 ms2))
      )
      ((equal bb '(2 50)) ;; 2键
      (setq pt0 (ssk ss 2))
      (setq ms2 (slmsg "当前<下中>" "讽玡<い>" "Current<Lower Middle>"))
      (command "move" ss "" pt0 pt)
      (princ (strcat ms1 ms2))
      )
      ((equal bb '(2 51)) ;; 3键
      (setq pt0 (ssk ss 3))
      (setq ms2 (slmsg "当前<右下>" "讽玡<>" "Current<Bottom Right>"))
      (command "move" ss "" pt0 pt)
      (princ (strcat ms1 ms2))
      )
      ((equal bb '(2 52));; 4键
      (setq pt0 (ssk ss 4))
      (setq ms2 (slmsg "当前<左中>" "讽玡<オい>" "Current<middle left>"))
      (command "move" ss "" pt0 pt)
      (princ (strcat ms1 ms2))
      )
      ((equal bb '(2 53));; 5键
      (setq pt0 (ssk ss 5))
      (setq ms2 (slmsg "当前<正中>" "讽玡<タい>" "Current<Center>"))
      (command "move" ss "" pt0 pt)
      (princ (strcat ms1 ms2))
      )
      ((equal bb '(2 54)) ;; 6键
      (setq pt0 (ssk ss 6))
      (setq ms2 (slmsg "当前<右中>" "讽玡<い>" "Current<middle right>"))
      (command "move" ss "" pt0 pt)
      (princ (strcat ms1 ms2))
      )
      ((equal bb '(2 55)) ;; 7键
      (setq pt0 (ssk ss 7))
      (setq ms2 (slmsg "当前<左上>" "讽玡<オ>" "Current<Top Left>"))
      (command "move" ss "" pt0 pt)
      (princ (strcat ms1 ms2))
      )
      ((equal bb '(2 56)) ;; 8键
      (setq pt0 (ssk ss 8))
      (setq ms2 (slmsg "当前<上中>" "讽玡<い>" "Current<Top Middle>"))
      (command "move" ss "" pt0 pt)
      (princ (strcat ms1 ms2))
      )
      ((equal bb '(2 57));; 9键
      (setq pt0 (ssk ss 9))
      (setq ms2 (slmsg "当前<右上>" "讽玡<>" "Current<Top Right>"))
      (command "move" ss "" pt0 pt)
      (princ (strcat ms1 ms2))
      )
    )
)
(setvar "OSMODE" os)
(redraw)
)
;;铺捉、正交移动、复制、旋转、放缩....---(一级)----
;;ss: 图块 选择集 实体 实体表 || p0:移动起点 or nil
;;(domov-os (setq ss (ssget)) p0)
;;图块返回图块 ;其他 处理后选择集
(defun domov-os (ss p0 / e_lst pt pt1 loop ang ang0 dis f3 f8 bb p10 p00 n e ee kk a b nam e1 ee)
(if (= p0 nil) (setq p0 (ssmpt ss)))
(if (null c:sl-tkgl)
    (load (strcat sl-path0 "\\Support\\" "sl-tkgl.VLX"))
)
(setq e_lst (sysvar '("CMDECHO" "NOMUTT" "OSMODE" "ORTHOMODE")) ee (entlast))
(cond
    ((and (= (type ss) 'ENAME) (/= (dxf1 ss 0) "INSERT")) ;图元
      (setq e (sl-sb (ssadd ss) p0) kk t)
    )
    ((and (= (type ss) 'ENAME) (= (dxf1 ss 0) "INSERT")) ;图块
      (setq e ss kk nil)
    )
    ((= (type ss) 'LIST) ;实体表
      (setq ss (sl:pickset-fromlist ss))
      (setq e (sl-sb ss p0) kk t)
    )
    ((= (type ss) 'PICKSET) ;选择集
      (if (> (sslength ss) 1)
      (setq e (sl-sb ss p0) kk t)
      )
      (if (= (sslength ss) 1)
      (progn
          (setq nam (ssname ss 0))
          (if (= (dxf1 nam 0) "INSERT")
            (setq e nam kk nil)
            (setq e (sl-sb ss p0) kk t)
          )
      )
      )
    )
)
(command "_.undo" "be")
(setvar "CMDECHO" 0)
(setvar "NOMUTT" 1)
(princ
    (slmsg
      "\n->[逆转90度(TAB)/取角(A)/LIN.(E)/<-镜向->(D)/↑镜向 ↓(S)/放大(Q)/缩小(W)/大一倍(+)/小一半(-)/基点(X)/正交(F8)/扑捉(F3)](空格..复制)(左键 插入)(右键 退出)"
      "\n->[癴锣90(TAB)/à(A)/LIN.(E)/<-描->(D)/◆描 □(S)/(Q)/罽(W)/(+)/(-)/膀翴(X)/タユ(F8)/汲(F3)](..確)(オ龄 础)(龄 癶)"
      "\n->(Spaced..copy)(Left Insert)(Right Exit)"
    )
)
(setq loop t pt1 p0 ang 0 f8 (getvar "ORTHOMODE") f3 (getvar "OSMODE"))
(while loop
    (setq bb (grread t 15 2) p00 (cadr bb))
    (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) (redraw)
      )   
      ((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) (redraw)
      )
      ((= (car bb) 5)
      (redraw)
      (if (= f8 1)
          (if (< (abs (- (car p00) (car p0))) (abs (- (cadr p00) (cadr p0))))
            (setq pt (list (car p00) (cadr p0)))
            (setq pt (list (car p0)(cadr p00)))
          )
          (setq pt p00)
      )
      (if (> (/ (distance p0 p00) (getvar "VIEWSIZE")) 0.001)
          (if (and (<= f3 16384) (> f3 0))
            (sl_subupd e 10 (setq pt (slosnappt e pt)))
            (sl_subupd e 10 pt)
          )
      )
      (setq p0 pt)
      )
      ((member bb '((2 9)));;table 键
      (setq ang (+ ang pi2))
      (sl_subupd e 50 ang)
      (setq e (blkwzgz e))
      )
      ((member bb '((2 65) (2 97)))   ;;A 旋转定角
      (redraw e 2)
      (sl_subupd e 50 0)
      (setq a (car (ebox4 e)))
      (setq b (polar a 0 500))
      (command ".rotate" e "" "_non" a "r" "_non" a (polar pt (angle pt b) (distance pt b)) pause)
      (setq e (blkwzgz e))
      )
      ((member bb '((2 69) (2 101)))   ;;E e 齐线
      (setq e1 (car (setq ee (entsel (slmsg "\n -->请选择要对齐的实体" "\n -->叫匡拒璶癸霍龟砰" "\n -->Please select the entity to align")))))
      (setq ang (e-ang e1 (cadr ee)))
      (sl_subupd e 50 ang)
      (setq e (blkwzgz e))
      )
      ((member bb '((2 115) (2 83)));;S s 上下翻
      (command "mirror" e "" "_non" pt (mapcar '- pt '(1 0)) "Y")
      (setq e (blkwzgz e))
      )
      ((member bb '((2 100) (2 68))) ;;D d 左右翻
      (command "mirror" e "" "_non" pt (mapcar '- pt '(0 1)) "Y")
      (setq e (blkwzgz e))
      )
      ((or (member bb '((2 13))) (= (car bb) 3));;左键、回车
      (command "copy" e "" "_non" '(0 0) "_non" '(0 0))
      (setq e (entlast) p10 (dxf1 e 10))
      (setq ang0 (angle pt1 p10) dis (distance pt1 p10) pt1 p10)
      )
      ((and ang0 dis (member bb '((2 32)))) ;;空格键
      (sl_subupd e 10 (setq p10 (polar p10 ang0 dis)))
      (setq pt1 p10)
      (command "copy" e "" "_non" '(0 0) "_non" '(0 0))
      (setq e (entlast))
      )
      ((member bb '((2 87) (2 119)))         ;;缩小W w
      (command "scale" e "" "_non" pt "0.9")
      )
      ((member bb '((2 81) (2 113)))         ;;放大Q q
      (command "scale" e "" "_non" pt "1.1")
      )
      ((equal bb '(2 45))         ;;缩小一半 -
      (command "scale" e "" "_non" pt "0.5")
      )
      ((member bb '((2 43) (2 61))) ;;放大一倍 +
      (command "scale" e "" "_non" pt "2.0")
      )
      ((member bb '((2 88) (2 120)));;基点 X x
      (setq p0 (getpoint (slmsg "\n 基点" "\n 膀翴" "\n Basic Point")))
      (sl-blockbaseedit e p0)
      )
      ((or t (member (car bb) '(11 25)));;右键 其余键
      (entdel e)
      (setq loop nil)
      )
    )
)
(setq s (last_ent ee))
(if (= kk t) ;非块
    (repeat (setq n (sslength s))
      (vl-catch-all-apply 'exp-blk (list (ssname s (setq n (1- n)))))
    )
)
(command "_.undo" "e")
(mapcar 'eval e_lst)
ss
)
;;移动-拷贝-旋转-镜像-递增-放缩------(一级)---------
;;ss:实体、实体表、选择集 p0 移动起点 nil | k: t(move) nil(copy)
(defun sldomov (ss p0 k / e_lst p1 pt pt1 loop ang dis f3 f8 bb p00 a b e1 ee)
(setq e_lst (sysvar '("QAFLAGS" "CMDECHO" "NOMUTT" "OSMODE" "ORTHOMODE")))
(cond
    ((= (type ss) 'ENAME) (setq ss (ssadd ss))) ;图元
    ((= (type ss) 'LIST) (setq ss (sl:pickset-fromlist ss))) ;实体表
)
(command "_.undo" "be") ;;舍弃高级代码,加速
(setvar "CMDECHO" 0) ;;命令显示关闭
(setvar "NOMUTT" 1)
(setvar "QAFLAGS" 0)
(if (= p0 nil)
    (setq p0 (ssmpt ss))
)
(princ
    (slmsg
      "\n->[逆转90度(TAB)/取角(A)/LIN.(E)/<-mir->(D)/↑mir ↓(S)/放大(Q)/缩小(W)/递增(Z)/递减(J)/大一倍(+)/小一半(-)/复制当前(C)/基点(X)/正交(F8)/扑捉(F3)](空格..复制)(左键>当前)(右键>退出)"
      "\n->[癴锣90(TAB)/à(A)/LIN.(E)/<-mir->(D)/◆mir □(S)/(Q)/罽(W)/患糤(Z)/患搭(J)/(+)/(-)/確讽玡(C)/膀翴(X)/タユ(F8)/汲(F3)](..確)(オ龄>讽玡)(/龄>癶)"
      "\n->Spaced..Copy/Right>Exit"
    )
)
(setq loop t pt1 p0 f8 (getvar "ORTHOMODE") f3 (getvar "OSMODE"))
(while loop
    (setq bb (grread t 15 2) p00 (cadr bb))
    (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) (redraw)
      )   
      ((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) (redraw)
      )
      ((= (car bb) 5)
      (redraw)
      (if (= f8 1)
          (if (< (abs (- (car p00) (car p0))) (abs (- (cadr p00) (cadr p0))))
            (setq pt (list (car p00) (cadr p0)))
            (setq pt (list (car p0) (cadr p00)))
          )
          (setq pt p00)
      )
      (if (and (<= f3 16384) (> f3 0) (/= f8 1))
          (setq pt (slosnappt ss pt))
      )
      (if (> (distance p0 pt) 0.001)
          (command "move" ss "" "_non" p0 "_non" pt)
      )
      (setq p0 pt)
      )
      ((member bb '((2 9)))      ;;table 键
      (command "ROTATE" ss "" "_non" pt 90)
      (setq ss (sl-wzgz ss))
      )
      ((member bb '((2 65) (2 97)))   ;;A 旋转定角
      (ss-rotang ss 0) ;选择集先转0度水平
      (setq a (ss9pt ss 1))
      (setq b (polar a 0 500))
      (command ".rotate" ss "" "_non" a "r" "_non" a (polar pt (angle pt b) (distance pt b)) pause)
      (setq ss (sl-wzgz ss))
      )
      ((member bb '((2 115) (2 83)));;S s 上下翻
      (command "mirror" ss "" "_non" pt (mapcar '- pt '(1 0)) "Y")
      )
      ((member bb '((2 100) (2 68))) ;;D d 左右翻
      (command "mirror" ss "" "_non" pt (mapcar '- pt '(0 1)) "Y")
      )
      ((or (member bb '((2 13))) (= (car bb) 3));;左键、回车
      (if (= k t) ;;移动
          (setq loop nil)
          (progn
            (command "copy" ss "" "_non" '(0 0) "_non" '(0 0))
            (setq ang (angle pt1 pt) dis (distance pt1 pt) pt1 pt)
          )
      )
      )
      ((member bb '((2 69) (2 101)))   ;;E e 齐线
      (setq ss (ss-rotang ss 0))
      (setq e1 (car (setq ee (entsel (slmsg "\n -->请选择要对齐的实体" "\n -->叫匡拒璶癸霍龟砰" "\n -->Please select the entity to align")))))
      (setq ang (e-ang e1 (cadr ee)))
      (setq ss (ss-rotang ss ang))
      (setq ss (sl-wzgz ss))
      )
      ((member bb '((2 67) (2 99)))   ;;C c 复制在当前
      (command "copy" ss "" "_non" '(0 0) "_non" '(0 0))
      (setq ang (angle pt1 pt) dis (distance pt1 pt) pt1 pt)
      )
      ((and (member bb '((2 32))) ang dis) ;;空格键
      (command "copy" ss "" "_non" '(0 0) "_non" '(0 0))
      (command "MOVE" ss "" "_non" pt1 "_non" (setq pt1 (polar pt1 ang dis))) ;;移位
      )
      ((member bb '((2 87) (2 119)))         ;;缩小W w
      (command "scale" ss "" "_non" pt "0.9")
      )
      ((member bb '((2 81) (2 113)))         ;;放大Q q
      (command "scale" ss "" "_non" pt "1.1")
      )
      ((equal bb '(2 45))         ;;缩小一半 -
      (command "scale" ss "" "_non" pt "0.5")
      )
      ((member bb '((2 43) (2 61))) ;;放大一倍 +
      (command "scale" ss "" "_non" pt "2.0")
      )
      ((member bb '((2 90) (2 122)));;递增 Z z
      (setq ss (ss++ ss 1))
      )
      ((member bb '((2 74) (2 106)));;递减 J j
      (setq ss (ss++ ss -1))
      )
      ((member bb '((2 88) (2 120)));;基点 X x
      (command "MOVE" ss "" "_non" pt "_non" p0);;移回去
      (setq p1 (getpoint (slmsg "\n 基点" "\n 膀翴" "\n Basic Point")))
      (command "MOVE" ss "" "_non" p1 "_non" p0)
      )
      ((or t (member (car bb) '(11 25)));;右键 其余键
      (if (= k t) ;;移动
          (command "MOVE" ss "" "_non" pt "_non" p0);;移回去
          (sl:erase ss)
      )
      (setq loop nil)
      )
    )
)
(redraw)
(command "_.undo" "e")
(mapcar 'eval e_lst)
(princ)
)

尘缘一生 发表于 2024-4-10 20:14:33

本帖最后由 尘缘一生 于 2024-4-12 07:15 编辑

怕怕吓一跳 发表于 2024-4-10 17:34
老陈准备开源了吗
有些代码，我以后找也好找，放这里，加之，看就可知道啥意思了，我也没空抽调内裤。
主要我得目的是钓鱼，看谁能回复什么的，透露点好的思路，办法，我好改进。
因为，我并不满意，还有改进的地方。

怕怕吓一跳 发表于 2024-4-10 17:34:05

老陈准备开源了吗

查看完整版本: 移动、复制综合集成