快速剖切符号

尘缘一生 发表于 2022-9-4 07:14:11

本帖最后由尘缘一生于 2022-9-4 13:23 编辑

请移步看看郎大师帖子--->

http://bbs.mjtd.com/forum.php?mo ... %D0&_dsign=fdef0f53
http://bbs.mjtd.com/forum.php?mo ... %D0&_dsign=dd9bbe32

1：具有机械，建筑两种样式，带箭头和不带箭头，
2：对箭头比例缩短一下，
3：对转折部分，写的文字去除，建筑好像不需要在中间写，机械专业需要吗？疑问，我不是机械专业。
slbl :为《三领设计》的比例，这个可以根据你的系统，给个值

[*];快速剖切符号------【开始】-----------
[*](defun c:pq (/ code data ent ent1 ent2 enttx enttx1 enttx2 gr loop lst pt r r0 r1 r2 r3 r4 s sltex oldorh jtk d1 d2 d3 d4)
[*](setq oldorh (getvar "ORTHOMODE"))
[*](setvar "ORTHOMODE" 1)
[*](_undo1)
[*](setq sltex (slquzf)) ;取字符功能
[*](setq pt (getpoint (strcat "\n 指定起点,或捕捉对齐点: <符号: " sltex " >")))
[*](if (ssget "c" pt pt) (setq pt (getpoint pt "\n 指定起点,或<捕捉对齐点>:")))
[*](setq lst (list pt))
[*](princ "\n 指定折点,或<结束选点>:")
[*](setq s (entlast) jtk (* slbl 0.3) d1 (* slbl 4.0) d2 (* slbl 5.0) d3 (* slbl 1.1) d4 (* slbl 3.0)) ;d1 直段长度 d2控制文字远近 d3 箭头直段长度 d4 箭头长度
[*](while (setq pt (getpoint pt))
[*] (setq lst (cons pt lst))
[*] (if (= (length lst) 2)
[*]    (mkpolyline2 (cadr lst) (polar (cadr lst) (angle (cadr lst) pt) d1) jtk) ;直段
[*] )
[*] (if (>= (length lst) 2)
[*]    (progn
[*]    (if ent (entmod (reent ent (list (polar (cadr lst) (angle (cadr lst) pt) d1)))));直段
[*]    (setq ent (entget (mkpolyline3 pt jtk jtk pt jtk jtk (polar pt (angle pt (cadr lst)) d1))));垂直两直段
[*]    )
[*] )
[*])
[*](if (= (getvar "dimblk") "")
[*] (progn ;机械带箭头
[*]    (setq ent1 (entget (mkpolyline3 (car lst) jtk jtk (car lst) (* slbl 1.2) 0.0 (car lst))))
[*]    (setq ent2 (entget (mkpolyline3 (last lst) jtk jtk (last lst) (* slbl 1.2) 0.0 (last lst))))
[*] )
[*] (progn ;建筑取消箭头
[*]    (setq ent1 (entget (mkpolyline3 (car lst) jtk jtk (car lst) jtk jtk (car lst))))
[*]    (setq ent2 (entget (mkpolyline3 (last lst) jtk jtk (last lst) jtk jtk (last lst))))
[*] )
[*])
[*](setq loop t)
[*](setvar "ORTHOMODE" oldorh)
[*](princ "\n 移动鼠标,指定箭头方向:")
[*](while loop
[*] (setq gr (grread t 15 0) code (car gr) data (cadr gr))
[*] (cond
[*]    ((= code 5)
[*]    (setq r0 (get3ptang (cadr lst) (car lst) data))
[*]    (if (<= r0 pi)
[*]       (setq r (+ (angle (car lst) (cadr lst)) (setq r0 pi2)) r2 (+ (angle (car lst) (cadr lst)) (setq r3 pi2)))
[*]       (setq r (+ (angle (car lst) (cadr lst)) (setq r0 3pi2)) r2 (+ (angle (car lst) (cadr lst)) (setq r3 3pi2)))
[*]    )
[*]    (if (null enttx1)
[*]       (progn
[*]          (if (null enttx)
[*]          (progn
[*]             (setq enttx (entget (mktext (polar (car lst) r2 d2) sltex d1)))
[*]             (setq enttx1 enttx)
[*]          )
[*]          (progn
[*]             (entmake (cdr (emod enttx 11 (polar (car lst) r2 d2))))
[*]             (setq enttx1 (entget (entlast)))
[*]          )
[*]          )
[*]       )
[*]       (entmod (emod enttx1 11 (polar (car lst) r2 d2)))
[*]    )
[*]    (entmod (reent ent1 (list nil (polar (car lst) r d3) (polar (car lst) r d4)))) ;箭头1
[*]    (setq lst (reverse lst) r1 (angle (car lst) (cadr lst)) r (+ r0 r1 pi))
[*]    (entmod (reent ent2 (list nil (polar (car lst) r d3) (polar (car lst) r d4)))) ;箭头2
[*]    (setq r4 (- r1 r3))
[*]    (if enttx2
[*]       (entmod (emod enttx2 11 (polar (car lst) r4 d2)))
[*]       (progn
[*]          (entmake (cdr (emod enttx 11 (polar (car lst) r4 d2))))
[*]          (setq enttx2 (entget (entlast)))
[*]       )
[*]    )
[*]    (setq lst (reverse lst))
[*]    )
[*]    ((or (= code 3) (= code 11) (= code 25))
[*]    (setq loop nil)
[*]    (_undo2)
[*]    )
[*] )
[*])
[*](setq s (last_ent s))
[*](ssnum s sltex "A") ;最后的符号，弹窗再次确认
[*](princ)
[*]);快速剖面符号----【结束】-----

YuHB 发表于 2024-6-12 22:58:31

本帖最后由 YuHB 于 2024-6-12 23:10 编辑

huxu823 发表于 2024-4-13 13:57
注销了(_undo1)，然后也补上了这部分函数，还是没法用啊
;;;综合题主(尘缘一生)代码和题主提供链接中狼大师 (langjs)的帖子，稍微修改了下。
;;;这个应该是可以直接用的。
;;;感谢各位大师提供源码，膜拜大师啊。
(defun c:tt (/ code data ent ent1 ent2 enttx enttx1 enttx2 gr loop lst pt r r0 r1 r2 r3 r4sltex oldorh jtk d1 d2 d3 d4 s htbl pi2 3pi2 Font1)
(setq oldorh (getvar "ORTHOMODE"))
(setvar "ORTHOMODE" 1)
   (setq htbl 100 ;;比例设置
            pi2(* 0.5 pi)
            3pi2 (* 1.5 pi)
   );;参数赋值
   ;(_undo1)
   (command ".UNDO" "BE")

   (setq Font1 "Temp");;字体设置，根据自己要求修改
   (if (null (tblsearch "style" Font1))
            (entmake (list '(0 . "style") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord")
                                                      (cons 2 Font1) '(70 . 0) (cons 410.7) '(3 . "tssdeng.shx") '(4 . "hzfsex.shx")))
   );;字体设置,YuHB补充

(setq sltex (slquzf)) ;取字符功能
(setq pt (getpoint (strcat "\n 指定起点,或捕捉对齐点: <符号: " sltex " >")))
(if (ssget "c" pt pt) (setq pt (getpoint pt "\n 指定起点,或<捕捉对齐点>:")))
(setq lst (list pt))
(princ "\n 指定折点,或<结束选点>:")
(setq s (entlast) jtk (* htbl 0.3) d1 (* htbl 4.0) d2 (* htbl 5.0) d3 (* htbl 1.1) d4 (* htbl 3.0)) ;d1 直段长度 d2控制文字远近 d3 箭头直段长度 d4 箭头长度
(while (setq pt (getpoint pt))
(setq lst (cons pt lst))
(if (= (length lst) 2)
   (mkpolyline2 (cadr lst) (polar (cadr lst) (angle (cadr lst) pt) d1) jtk) ;直段
)
(if (>= (length lst) 2)
   (progn
   (if ent (entmod (reent ent (list (polar (cadr lst) (angle (cadr lst) pt) d1)))));直段
   (setq ent (entget (mkpolyline3 pt jtk jtk pt jtk jtk (polar pt (angle pt (cadr lst)) d1))));垂直两直段
   )
)
)
(if (= (getvar "dimblk") "")
(progn ;机械带箭头
   (setq ent1 (entget (mkpolyline3 (car lst) jtk jtk (car lst) (* htbl 1.2) 0.0 (car lst))))
   (setq ent2 (entget (mkpolyline3 (last lst) jtk jtk (last lst) (* htbl 1.2) 0.0 (last lst))))
)
(progn ;建筑取消箭头
   (setq ent1 (entget (mkpolyline3 (car lst) jtk jtk (car lst) jtk jtk (car lst))))
   (setq ent2 (entget (mkpolyline3 (last lst) jtk jtk (last lst) jtk jtk (last lst))))
)
)
(setq loop t)
(setvar "ORTHOMODE" oldorh)
(princ "\n 移动鼠标,指定箭头方向:")
(while loop
(setq gr (grread t 15 0) code (car gr) data (cadr gr))
(cond
   ((= code 5)
   (setq r0 (get3ptang (cadr lst) (car lst) data))
   (if (<= r0 pi)
      (setq r (+ (angle (car lst) (cadr lst)) (setq r0 pi2)) r2 (+ (angle (car lst) (cadr lst)) (setq r3 pi2)))
      (setq r (+ (angle (car lst) (cadr lst)) (setq r0 3pi2)) r2 (+ (angle (car lst) (cadr lst)) (setq r3 3pi2)))
   )
   (if (null enttx1)
      (progn
         (if (null enttx)
         (progn
            (setq enttx (entget (MakeTxt (polar (car lst) r2 d2) sltex d1 Font1)))
            (setq enttx1 enttx)
         )
         (progn
            (entmake (cdr (emod enttx 11 (polar (car lst) r2 d2))))
            (setq enttx1 (entget (entlast)))
         )
         )
      )
      (entmod (emod enttx1 11 (polar (car lst) r2 d2)))
   )
   (entmod (reent ent1 (list nil (polar (car lst) r d3) (polar (car lst) r d4)))) ;箭头1
   (setq lst (reverse lst) r1 (angle (car lst) (cadr lst)) r (+ r0 r1 pi))
   (entmod (reent ent2 (list nil (polar (car lst) r d3) (polar (car lst) r d4)))) ;箭头2
   (setq r4 (- r1 r3))
   (if enttx2
      (entmod (emod enttx2 11 (polar (car lst) r4 d2)))
      (progn
         (entmake (cdr (emod enttx 11 (polar (car lst) r4 d2))))
         (setq enttx2 (entget (entlast)))
      )
   )
   (setq lst (reverse lst))
   )
   ((or (= code 3) (= code 11) (= code 25))
   (setq loop nil)
   ;(_undo2)
                           (command ".UNDO" "E")
   )
)
)

;(setq s (last_ent s))
;(ssnum s sltex "A") ;最后的符号，弹窗再次确认
(if (/= "" (setq txt (getstring (strcat "\n输入剖面号: <" sltex ">"))))
            (ModTxtNextE s txt)
);;修改剖面号,YuHB修改
   (command ".UNDO" "E")
(princ)
);快速剖面符号----【结束】-----

;;返回：将图元e之后新生成的文字内容修改为txt
(defun ModTxtNextE (e txt / ent)
(if e
            (while (setq e (entnext e))
                     (if (wcmatch (cdr (assoc 0 (setq ent (entget e)))) "TEXT")
                           (progn
                                    (setq ent (subst (cons 1 txt) (assoc 1 ent) ent))
                                    (entmod ent)
                           )
                     )
            )
)
   (prin1)
)

;取得图元参数值内容----------（一级）-------
;;(setq h (dxf1 ent 40))
; ent 为实体名或实体entget，
(defun dxf1 (ent i / tmp)
(if (= (type ent) 'ENAME)
(setq ent (entget ent '("*")))
)
(setq tmp (cdr (assoc i ent)))
(if (null tmp)
(cond
   ((= i 66) 0)
   ((= i 48) (getvar "celtscale"))
   ((= i 62) 256)
   ((= i 370) (setq tmp -1))
   ((= i 6) "ByLayer")
)
tmp
)
)
;(一级)====A-Z递增===取最大字符========
(defun slquzf ()
(if (setq ss (ssget "X" (list '(0 . "TEXT") '(1 . "") '(-3 ("POQIR")))))
(progn
   (setq lst '())
   (repeat (setq i (sslength ss))
   (setq lst (cons (dxf1 (ssname ss (setq i (1- i))) 1) lst))
   )
   (setq sltex (chr (1+ (ascii (car (vl-sort lst '>))))))
)
(setq sltex "A")
)
)

(defun MakeTxt (pt sltex h font)
(regapp "POQIR")
(entmake (list '(0 . "TEXT") '(62 . 3) (cons 7 font) (cons 10 pt) (cons 40 h) (cons 1 sltex) '(41 . 0.7) '(72 . 1) (cons 11 pt) '(73 . 2)
         (list -3 (list "POQIR" (cons 1000 sltex)))
      )
)
(entlast)
)

(defun mkpolyline2 (pt1 pt2 h)
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(62 . 4) '(100 . "AcDbPolyline") (cons 90 2) (cons 10 pt1)
                                                      (cons 43 h) (cons 10 pt2) (cons 43 h)
         )
)
(entlast)
)
(defun mkpolyline3 (pt1 w1 w2 pt2 w3 w4 pt3)
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(62 . 4) '(100 . "AcDbPolyline") '(90 . 3) (cons 10 pt1) (cons 40 w1)
                                                      (cons 41 w2) (cons 10 pt2) (cons 40 w3) (cons 41 w4) (cons 10 pt3)
         )
)
(entlast)
)

; 按点表顺序更新多段线顶点,无须更换的顶点用nil代替。by:langjs
(defun reent (ent lst / n x)
(mapcar
   '(lambda (x)
      (setq n (car lst))
      (if (= (car x) 10)
      (if (/= nil n t (setq lst (cdr lst)))
         (cons 10 n)
         x
      )
      x
      )
   )
   ent
)
)

(defun get3ptang (p1 p2 p3 / ans a b an)
(setq ans (list (angle p1 p2) (angle p3 p2))
                     a (apply
                                    'min
                                    ans
                           )
                     b (apply
                                    'max
                                    ans
                           )
                     an (- b a)
)
(if (= a (car ans))
   an
   (- (* 2 pi) an)
)
)

(defun emod (ent i n)
(subst
   (cons i n)
   (assoc i ent)
   ent
)
)

尘缘一生 发表于 2022-9-5 06:45:50

本帖最后由尘缘一生于 2022-9-5 06:47 编辑

fxlt619 发表于 2022-9-4 19:06
还是不能用啊

[*];取得图元参数值内容----------（一级）-------
[*];;(setq h (dxf1 ent 40))
[*]; ent 为实体名或实体entget，
[*](defun dxf1 (ent i / tmp)
[*](if (= (type ent) 'ENAME)
[*] (setq ent (entget ent '("*")))
[*])
[*](setq tmp (cdr (assoc i ent)))
[*](if (null tmp)
[*] (cond
[*]    ((= i 66) 0)
[*]    ((= i 48) (getvar "celtscale"))
[*]    ((= i 62) 256)
[*]    ((= i 370) (setq tmp -1))
[*]    ((= i 6) "ByLayer")
[*] )
[*] tmp
[*])
[*])
[*];(一级)====A-Z递增===取最大字符========
[*](defun slquzf ()
[*](if (setq ss (ssget "X" (list '(0 . "TEXT") '(1 . "") '(-3 ("POQIR")))))
[*] (progn
[*]    (setq lst '())
[*]    (repeat (setq i (sslength ss))
[*]    (setq lst (cons (dxf1 (ssname ss (setq i (1- i))) 1) lst))
[*]    )
[*]    (setq sltex (chr (1+ (ascii (car (vl-sort lst '>))))))
[*] )
[*] (setq sltex "A")
[*])
[*])

[*];A-Z递增创建扩展字符========(一级)=====
[*](defun mktext (pt sltex h)
[*](regapp "POQIR")
[*](entmake (list '(0 . "TEXT") '(62 . 3) (cons 7 "hz")(cons 10 pt) (cons 40 h) (cons 1 sltex) '(41 . 0.7) '(72 . 1) (cons 11 pt) '(73 . 2)
[*]          (list -3 (list "POQIR" (cons 1000 sltex)))
[*]       )
[*])
[*](entlast)
[*])

尘缘一生 发表于 2022-9-4 10:07:22

本帖最后由尘缘一生于 2022-9-4 13:31 编辑

liuhe 发表于 2022-9-4 09:36
;;; (_undo1)
(setq sltex (slquzf)) 这些自定义函数没注销即可这个，这个就是，写出来好比是A ,弹出的框，叫人为选择个，比如人为输入一个 10，就自动改为10，这个后续处理。
因为原郎大师，是画一个符号是 A 下一个就是B..... ；这并不实用，为什么？谁画图，这个符号连续画，基本不可能。
所以，不如，这个文字是啥，最后输入个不就完了吗。

mokson 发表于 2022-9-4 08:12:25

CAD已经自带这个功能，命令是 viewsectionstyle

liuhe 发表于 2022-9-4 09:36:20

;;; (_undo1)
(setq sltex (slquzf)) 这些自定义函数没有

尘缘一生 发表于 2022-9-4 10:13:49

mokson 发表于 2022-9-4 08:12
CAD已经自带这个功能，命令是 viewsectionstyle
这是用多义线模拟的箭头，这是亮点。
画图纸，不建议用特殊实体去画。
我习惯：像CAD的射线，面域，多重引线，构造线，甚至连SPLINE都尽量避免采用。
会造成编辑部分的工具，代码很多，要么就需要一键转换别人的图纸入自己系统。。。。

liuhe 发表于 2022-9-4 10:28:58

尘缘一生发表于 2022-9-4 10:07
注销即可这个，这个就是，写出来好比是A ,弹出的框，叫人为选择个，比如人为输入一个 10，就自动改为10， ...

你用的什么gif软件啊，我录制的都是无法上传说是太大了:'(

尘缘一生 发表于 2022-9-4 10:36:17

本帖最后由尘缘一生于 2022-9-4 11:11 编辑

liuhe 发表于 2022-9-4 10:28
你用的什么gif软件啊，我录制的都是无法上传说是太大了

用的这个，录屏窗口尽量小，GIF尺寸会几何级增大。

fxlt619 发表于 2022-9-4 10:54:04

能单独使用吗？

liuhe 发表于 2022-9-4 11:04:00

尘缘一生发表于 2022-9-4 10:36
用的这个，录屏窗口尽量小，GIF尺寸会几何级增大。

大佬你这是快捷键不是程序本身啊

fxlt619 发表于 2022-9-4 19:06:49

还是不能用啊

页: [1] 2

明经CAD社区's Archiver

快速剖切符号