快速剖切符号

尘缘一生 · 发表于 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 r4  sltex 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 41  0.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 . "[A-Z]") '(-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 . "[A-Z]") '(-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

还是不能用啊

账号		自动登录	找回密码
密码			注册

快速剖切符号

本帖子中包含更多资源

评分

本帖子中包含更多资源

本帖子中包含更多资源

点评

点评