- 积分
- 2643
- 明经币
- 个
- 注册时间
- 2024-8-8
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2025-5-24 21:56:37
|
显示全部楼层
本帖最后由 逗亦斗霸 于 2025-5-25 15:47 编辑
请问一下,这段代码还有其他的范例吗?我尝试使用这段加到我动态引线捕捉里去只显示方框,靠近中点时不能正常显示三角形,在另一个拉线标注里倒是可以在靠近中点时正常显示三角形,谢谢~
 - (defun dectobin(n m / c f);;十进制转二进制
- (setq f(if(< n 0)1 0)n(abs n))
- (while(>(setq c(cons(rem n 2)c)n(/ n 2))0))
- (while(<(length c)(1- m))(setq c(cons 0 c)))
- (cons f c))
- (DEFUN DrawVecs(pt Vecs Size Color / xdir);;;G版函数绘制矢量
- (setq xdir(getvar'ucsxdir)
- Vecs(mapcar'(lambda(x)(mapcar'(lambda(a)(mapcar'+ pt(mapcar'*(setq a(trans a 0 xdir)a(list(caddr a)(car a)))(List size size))))x))Vecs))
- (GRVECS(APPLY 'APPEND(MAPCAR 'CONS(MAPCAR(FUNCTION (LAMBDA (x)Color))Vecs)Vecs))))
- (defun myosnap(pt / xpt mode osmod osmode Draftobj Size);;;修改G版函数带捕捉grread
- (redraw)
- (if(setq Draftobj(VLA-GET-DRAFTING(VLA-GET-PREFERENCES(VLAX-GET-ACAD-OBJECT)))
- osmod'("_END," "_MID," "_CEN," "_NOD," "_QUA," "_INT," "_INS," "_PER," "_TAN," "_NEA," "_NON," "_APP," "_EXT," "_PAR")
- osmode(reverse(DECTOBIN (getvar'osmode) 1))
- size(*(/(getvar "viewsize")(cadr(getvar "screensize")))(VLA-GET-AUTOSNAPMARKERSIZE Draftobj))
- xpt(osnap pt(apply'strcat(mapcar'(lambda(x y)(if(zerop x)""y))osmode osmod)))
- mode(CDR(ASSOC
- (if xpt(vl-some'(lambda(x)(if(equal xpt(cdr x)1e-8)(car x)))
- (vl-remove'nil(mapcar'(lambda(x y / xpt)(if(zerop x)nil(if(setq xpt(osnap pt y))(cons y xpt))))osmode osmod)))"_NON,")
- '(("_END,"((-1 1)(-1 -1))((-1 -1)(1 -1))((1 -1) (1 1))((1 1) (-1 1)))
- ("_MID,"((0 1.414) (-1.225 -0.707)) ((-1.225 -0.707)(1.225 -0.707))((1.225 -0.707) (0 1.414)))
- ("_CEN,"((0 1) (-0.707 0.707))((-0.707 0.707)(-1 0))((-1 0) (-0.707 -0.707))((-0.707 -0.707)(0 -1))
- ((0 -1)(0.707 -0.707))((0.707 -0.707)(1 0)) ((1 0) (0.707 0.707))((0.707 0.707) (0 1)))
- ("_NOD,"((0 1) (-0.707 0.707))((-0.707 0.707)(-1 0))((-1 0)(-0.707 -0.707))((-0.707 -0.707)(0 -1))((0 -1)(0.707 -0.707))
- ((0.707 -0.707)(1 0))((1 0)(0.707 0.707))((0.707 0.707)(0 1))((-1 1)(1 -1))((-1 -1)(1 1)))
- ("_QUA,"((0 1.414)(-1.414 0))((-1.414 0)(0 -1.414))((0 -1.414)(1.414 0))((1.414 0)(0 1.414)))
- ("_INT,"((-1 1)(1 -1))((-1 -1)(1 1))((1 0.859)(-0.859 -1))((-1 0.859)(0.859 -1))((0.859 1)(-1 -0.859))((-0.859 1)(1 -0.859)))
- ("_INS,"((-1 1)(-1 -0.1))((-1 -0.1)(0 -0.1))((0 -0.1)(0 -1.0))((0 -1.0)(1 -1))
- ((1 -1)(1 0.1))((1 0.1)(0 0.1))((0 0.1) (0 1.0))((0 1.0)(-1 1)))
- ("_PER,"((-1 1)(-1 -1))((-1 -1)(1 -1))((0 -1)(0 0))((0 0)(-1 0)))
- ("_TAN,"((0 1)(-0.707 0.707))((-0.707 0.707)(-1 0))((-1 0)(-0.707 -0.707))((-0.707 -0.707)(0 -1))
- ((0 -1)(0.707 -0.707))((0.707 -0.707)(1 0))((1 0)(0.707 0.707))((0.707 0.707)(0 1))((1 1)(-1 1)))
- ("_NEA,"((-1 1)(1 -1))((1 -1)(-1 -1))((-1 -1)(1 1))((1 1)(-1 1)))
- ("_NON,")
- ("_APP,"((-1 1)(-1 -1))((-1 -1)(1 -1))((1 -1)(1 1))((1 1)(-1 1))((-1 1)(1 -1))((-1 -1)(1 1)))
- ("_EXT,"((0.1 0)(0.13 0))((0.2 0)(0.23 0))((0.3 0)(0.33 0)))
- ("_PAR"((0 1)(-1 -1))((1 1)(0 -1)))))))
- (DrawVecs(setq xpt(if xpt xpt pt))mode size(VLA-GET-AUTOSNAPMARKERCOLOR Draftobj)))
- (if xpt xpt pt))
- (defun c:tvvt(/ e xpt) ;;选择一个圆进行移动
- (while(setq e(ssget":E:S"'((0 . "circle"))))
- (setq e(entget(ssname e 0)))
- (while(/=(car(setq xpt(grread t 15 0)))3)(redraw)
- (if(=(car xpt)5)(entmod(append e(list(cons 10(myosnap(cadr xpt)))))))
- ))
- )
-
- (defun bz (/ *error* name1 name2 name3)
- (defun *error* (msg) ;将描述错误的字符串存入变量msg
- (entdel name1)
- (entdel name2)
- (if name3
- (entdel name3)
- )
- (princ "错误: ")
- (princ msg)
- ) ;打印错误信息
-
- (setq ty (getvar "TEXTSTYLE"))
- (setq ht (atof txtht))
- (if (= ht 0)
- (progn
- (prompt "字高为0!")
- (terpri)
- );progn
- );if
- (setq Scale (/ ht 2.5));
- (setq kd1 (caadr (textbox (list '(0 . "text")
- (cons 1 txt1)
- (cons 40 ht)
- (cons 41 1)
- (cons 7 ty)
- (cons 62 7)
- )
- )
- )
- )
- ;字高ht,字宽高比1,可以自己设置,字体为当前字体
- (setq kd2 (caadr (textbox (list '(0 . "text")
- (cons 1 txt2)
- (cons 40 ht)
- (cons 41 1)
- (cons 7 ty)
- (cons 62 7)
- )
- )
- )
- )
- ;字高ht,字宽高比1,可以自己设置,字体为当前字体
- (setq kd (max kd1 kd2)
- kd (+ kd (* 0.50 Scale))
- )
- (setq p (getpoint "\n输入基点:"))
- (setq pd t)
- (while pd
- (setq gr (grread t 4 1)
- mode (car gr)
- pt (myosnap (cadr gr))
- )
- (if (= kd3 0)
- (setq kd kd1)
- )
- (if (and (listp pt) (>= (car pt) (car p)))
- (progn
- (setq p0 (polar pt 0 kd))
- (setq p1 (polar pt 0 (/ (- kd kd1) 2))
- p1 (polar p1 (angtof "90") (* 0.70 Scale))
- )
- (setq p2 (polar pt 0 (/ (- kd kd2) 2))
- p2 (polar p2 (angtof "270") (* 3.20 Scale))
- )
- )
- )
- (if (and (listp pt) (< (car pt) (car p)))
- (progn
- (setq p0 (polar pt pi kd))
- (setq p1 (polar p0 0 (/ (- kd kd1) 2))
- p1 (polar p1 (angtof "90") (* 0.70 Scale))
- )
- (setq p2 (polar p0 0 (/ (- kd kd2) 2))
- p2 (polar p2 (angtof "270") (* 3.20 Scale))
- )
- )
- )
- (if (= mode 5)
- (progn
- (if name1
- (entdel name1)
- )
- (entmake (list '(0 . "LWPOLYLINE")
- '(100 . "AcDbEntity")
- '(100 . "AcDbPolyline")
- '(90 . 3)
- (cons 10 p)
- (cons 10 pt)
- (cons 10 p0)
- (cons 62 3)
- )
- )
- (setq name1 (entlast))
- (if name2
- (entdel name2)
- )
- (entmake (list '(0 . "text")
- (cons 1 txt1)
- (cons 40 ht)
- (cons 41 1)
- (cons 10 p1)
- (cons 7 ty)(cons 62 7)
- )
- )
- ;字高ht,字宽高比1,可以自己设置,字体为当前字体
- (setq name2 (entlast))
- (if name3
- (entdel name3)
- )
- (if (= kd3 1)
- (entmake (list '(0 . "text")
- (cons 1 txt2)
- (cons 40 ht)
- (cons 41 1)
- (cons 10 p2)
- (cons 7 ty)(cons 62 7)
- )
- )
- )
- ;字高ht,字宽高比1,可以自己设置,字体为当前字体
- (if (= kd3 1)
- (setq name3 (entlast))
- )
- )
- (redraw)
- )
- (if (= mode 3)
- (setq pd nil)
- )
- (if (or (= mode 2) (= mode 25))
- (progn (setq pd nil)
- (entdel name1)
- (entdel name2)
- (if name3
- (entdel name3)
- )
- )
- )
- )
- (princ)
- )
- (defun getdata ()
- (setq txt1 (get_tile "a1"))
- (setq txt2 (get_tile "a2"))
- (if (= (get_tile "a3") "0")
- (setq kd3 0)
- (setq kd3 1)
- )
- (setq txtht(get_tile "a4"))
- )
- (defun c:bz ()
- ;(步骤1)建立临时对话框
- (setq tempname (vl-filename-mktemp "temp.dcl")
- filen (open tempname "w")
- )
- (foreach stream
- '("bz:dialog{"
- "\n label = "
- 动态引线标注
- ";"
- "\n :edit_box {key = "a1"; label = "线上文字:"; width = 40 ;}"
- "\n :toggle {key = "a3"; label = "增加线下文字"; value = "
- 0
- ";}"
- "\n :edit_box {key = "a2"; label = "线下文字:"; width = 40; is_enabled = false;}"
- "\n :edit_box {key = "a4"; label = "文字高度:"; width = 20; }"
- "\n ok_cancel;}"
- )
- (princ stream filen)
- )
- (close filen)
- (setq dclname tempname)
- ;(步骤2)加载并显示对话框
- (setq dcl_re (load_dialog dclname))
- (if (not (new_dialog "bz" dcl_re))
- (exit)
- )
- ;(步骤3)定义对话框控件(运用set_tile、action_tile、mode_tile、get_tile等函数)
- (if txt1
- (set_tile "a1" txt1)
- (set_tile "a1" "动态标注")
- )
- (if txt2
- (set_tile "a2" txt2)
- (set_tile "a2" "动态标注")
- )
- (if kd3
- (set_tile "a3" (rtos kd3))
- ) ;注意set_tile函数中赋值均为字符串(带双引号),就连关键词也要加上双引号。
- (if (= kd3 0)
- (mode_tile "a2" 1)
- )
- (if (= kd3 1)
- (mode_tile "a2" 0)
- )
- (if txtht
- (set_tile "a4" txtht)
- (set_tile "a4" "150")
- )
- (action_tile
- "a3"
- "(if (= (get_tile "a3") "0") (mode_tile "a2" 1) (mode_tile "a2" 0))"
- ) ;点击时才起作用
- (action_tile "accept" "(getdata)(done_dialog 1)")
- (action_tile "cancel" "(done_dialog)")
- ;(步骤4)激活并卸载对话框,并进行对话框隐藏后的操作。
- (setq std (start_dialog))
- (unload_dialog dcl_re)
- (vl-file-delete dclname)
- (if (= std 1)
- (bz)
- )
- (princ)
- )
|
|