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-5 06:45
[*];取得图元参数值内容----------（一级）-------
[*];;(setq h (dxf1 ent 40))
[*]; ent 为实体名 ...
注销了(_undo1)，然后也补上了这部分函数，还是没法用啊 兄弟 你的代码缺的函数再多点，发帖不能这样发啊..... 就不能发个能用的吗？不是源码也没关系 本帖最后由 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
)
) YuHB 发表于 2024-6-12 22:58
;;;综合题主(尘缘一生)代码和题主提供链接中狼大师 (langjs)的帖子，稍微修改了下。
;;;这个应该是可以 ...
请问一下，那两个L型剖切符号怎么连成多段线呢？第二个L型的两条线点J合并会有个缺口，第一个则不会；并且第二个L型的长线只能向左延伸，不能向右延伸，第一个L型的的长线则可向两头延伸（曾怀疑不能正常连续是这个原因），谢谢~ 逗亦斗霸 发表于 2024-8-8 12:27
请问一下，那两个L型剖切符号怎么连成多段线呢？第二个L型的两条线点J合并会有个缺口，第一个则不会；并 ...
先前看到消息一直没回复，今天花时间看了下代码，然后再大概修改了下，看能不能凑合着用了，哈哈。感谢您的提示，感谢楼主和狼大师的源码。
YuHB 发表于 2024-8-27 20:13
先前看到消息一直没回复，今天花时间看了下代码，然后再大概修改了下，看能不能凑合着用了，哈哈。感谢您 ...
非常感谢大佬的更新，我改了一下字体和比例后完全满足我的需求了
页:
1
[2]