浩辰CAD2018很多小插件都不能正常运行
公司都是 用的过程号称cad，但习惯于用各种插件提高制图效率，然而，从网上下的各种插件，浩辰上几乎都运行不了，比如下面的小插件动态引线标注，Autocad上能正常运行，在浩辰上就不行，有什么办法吗？或者需要对源码进行调配？有没高手指点指点？(defun c:yb (/ #erryx001 $orr bb bi code data dcl_re dclname ent ent1 ent2 filen gr i lst n1 n2 n3 name1 name2 nent pt pt0
ptlst stream tempname tulst tulst1 tulst2 txlst txlst1 ty w x x0 x1 xunh y0 y1
)
(defun #erryx001 (s)
(entdel name1)
(entdel name2)
(command ".UNDO" "E")
(setq *error* $orr)
) ; 按点表顺序更新多段线顶点,无须更换顶点用nil代替。by:langjs
(defun reent (ent ptlst / i nent x)
(setq i -1
nent '()
)
(foreach x ent
(setq nent (append
nent
(list (if (and
(= (car x) 10)
(/= (nth (setq i (1+ i))
ptlst
) nil
)
)
(cons 10 (nth i ptlst))
x
)
)
)
)
)
)
(defun relst (x i lst) ; 替换表中第i个元素。
(if (= 0 i)
(cons x (cdr lst))
(cons (car lst) (relst x (1- i) (cdr lst)))
)
)
(defun getty (ty / lst x) ; 图层列表
(setq x (tblnext ty t))
(while (/= x nil)
(setq lst (cons (cdr (assoc 2 x)) lst))
(setq x (tblnext ty))
)
(acad_strlsort lst)
)
(defun showlst (i lst) ; 显示列表
(start_list i)
(mapcar
'add_list
lst
)
(end_list)
)
(defun show ()
(setq n1 (getvar "CLAYER")
n2 (getvar "CLAYER")
n3 (getvar "TEXTSTYLE")
tulst1 (cons n1 (vl-remove n1 tulst))
tulst2 (cons n2 (vl-remove n2 tulst))
txlst1 (cons n3 (vl-remove n3 txlst))
lstsz (relst n1 6 lstsz)
lstsz (relst n2 7 lstsz)
lstsz (relst n3 8 lstsz)
lstsz (relst '("开" "关") 9 lstsz)
)
(setvar "orthomode" 1)
(showlst "e07" '("开" "关"))
(showlst "e10" tulst1)
(showlst "e11" tulst2)
(showlst "e12" txlst1)
(showlst "e13" (nth 9 lstsz))
)
(defun ybgetdata ()
(setq txt (get_tile "e01"))
(if (= (get_tile "a3") "0") (setq kd3 0) (setq kd3 1))
(if (= kd3 1)(setq txt1 (get_tile "a2")))
)
(setvar "cmdecho" 0)
(setq $orr *error*)
(setq *error* #erryx001)
(command ".UNDO" "BE")
(if (null txt1) (setq txt1 ""))
(if (null txt ) (setq txt ""))
(while (/= bb 4)
(setq bi (getvar "DIMSCALE")
bb 3
xunh t
)
(if (null txt)
(setq txt "")
)
(if (null ptlast)
(setq ptlast '(0.0 0.0))
)
(if (null lstsz)
(setq lstsz (list (getvar "DIMTXT") (getvar "DIMCLRT") (getvar "DIMCLRD") (* 0.3 (getvar "DIMASZ")) (getvar "DIMEXO")
(cdr (assoc 41 (tblsearch "style" (getvar "TEXTSTYLE")))) (getvar "CLAYER") (getvar "CLAYER")
(getvar "TEXTSTYLE") '("开" "关") (* 0.1 (getvar "DIMASZ") )'("开" "关")'("箭头" "圆点")
)
)
)
(setq tulst (getty "LAYER")
txlst (getty "style")
n1 (nth 6 lstsz)
n2 (nth 7 lstsz)
n3 (nth 8 lstsz)
tulst1 (cons n1 (vl-remove n1 tulst))
tulst2 (cons n2 (vl-remove n2 tulst))
txlst1 (cons n3 (vl-remove n3 txlst))
)
(while (= bb 3)
(setq dclname (cond
((setq tempname (vl-filename-mktemp "yx.dcl")
filen (open tempname "w")
)
(foreach stream '("\n" "yx1:dialog {\n"
" label = \"引线标柱 2.0\" ;\n"
" :edit_box {key = \"e01\"; label = \"线上文字:\"; width = 40 ;}\n "
":toggle {key = \"a3\"; label = \"增加线下文字\";}\n"
":edit_box {key = \"a2\"; label = \"线下文字:\"; width = 40;}\n"
" :row { :button { key = \"e02\" ; label = \"确认\" ;is_default = true ; }\n"
" :button { key = \"e04\" ; label = \"设置\" ; }\n"
" :button { key = \"e03\" ; label = \"取消\" ; is_cancel = true ; } } }\n"
)
(princ stream filen)
)
(close filen)
tempname
)
)
)
(setq dcl_re (load_dialog dclname))
(if (not (new_dialog "yx1" dcl_re))
(exit)
)
(set_tile "e01" txt)
(if (= kd3 1)
(progn
(set_tile "a3" "1")
(mode_tile "a2" 0)
(set_tile "a2" txt1)
)
(progn
(set_tile "a3" "0")
(mode_tile "a2" 1))
)
(action_tile "e02" "(ybgetdata)(done_dialog 1)")
(action_tile "e04" "(setq txt (get_tile \"e01\"))(done_dialog 2)")
(action_tile "e03" "(setq txt (get_tile \"e01\"))(done_dialog 4)")
(action_tile "a3" "(if (= (get_tile \"a3\") \"0\") (mode_tile \"a2\" 1) (progn (mode_tile \"a2\" 0)(set_tile \"a2\" txt1)))") ;点击时才起作用
(setq bb (start_dialog))
(unload_dialog dcl_re)
(vl-file-delete dclname)
(if (= bb 2)
(progn
(setq dclname (cond
((setq tempname (vl-filename-mktemp "yx.dcl")
filen (open tempname "w")
)
(foreach stream '("\n" "yx1:dialog {\n"
" label = \"引线标柱设置\" ;\n" " :edit_box { label = \"文字高度\" ; key = \"e00\" ; }\n"
" :edit_box { label = \"宽度比例\" ; key = \"e08\" ; }\n"
" :edit_box { label = \"文字偏移\" ; key = \"e04\" ; }\n"
" :edit_box { label = \"文字颜色\" ; key = \"e01\" ; }\n"
" :edit_box { label = \"基线宽度\" ; key = \"e14\" ; }\n"
" :edit_box { label = \"箭头长度\" ; key = \"e03\" ; }\n"
" :edit_box { label = \"引线颜色\" ; key = \"e02\" ; }\n"
" :popup_list { label = \"线上递增\" ; key = \"e13\" ; }\n"
" :popup_list { label = \"线下递增\" ; key = \"e15\" ; }\n"
" :popup_list { label = \"正交对齐\" ; key = \"e07\" ; }\n"
" :popup_list { label = \"箭头形式\" ; key = \"e16\" ; }\n"
" :popup_list { label = \"文字样式\" ; key = \"e12\" ; }\n"
" :popup_list { label = \"文字图层\" ; key = \"e10\" ; }\n"
" :popup_list{ label = \"引线图层\" ; key = \"e11\" ; }\n"
" :row { :button { key = \"e05\" ; label = \"确认\" ;is_default = true ; }\n"
" :button { key = \"e09\" ; label = \"默认\" ; }\n"
" :button { key = \"e06\" ; label = \"取消\" ; is_cancel = true ; } } }\n"
)
(princ stream filen)
)
(close filen)
tempname
)
)
)
(setq dcl_re (load_dialog dclname))
(if (not (new_dialog "yx1" dcl_re))
(exit)
)
(set_tile "e00" (rtos (nth 0 lstsz) 2 2))
(set_tile "e01" (itoa (nth 1 lstsz)))
(set_tile "e02" (itoa (nth 2 lstsz)))
(set_tile "e03" (rtos (nth 3 lstsz) 2 2))
(set_tile "e04" (rtos (nth 4 lstsz) 2 2))
(set_tile "e08" (rtos (nth 5 lstsz) 2 2))
(set_tile "e14" (rtos (nth 10 lstsz) 2 2))
(showlst "e10" tulst1)
(showlst "e11" tulst2)
(showlst "e12" txlst1)
(showlst "e13" (nth 9 lstsz))
(showlst "e15" (nth 11 lstsz))
(showlst "e16" (nth 12 lstsz))
(if (= (getvar "ORTHOMODE") 0)
(showlst "e07" '("关" "开"))
(showlst "e07" '("开" "关"))
)
(action_tile "e01" "(if (/=(setq c (acad_colordlg (nth 1 lstsz))) nil) (set_tile \"e01\" (itoa c) ))")
(action_tile "e02" "(if (/=(setq c (acad_colordlg (nth 2 lstsz))) nil) (set_tile \"e02\" (itoa c) ))")
(action_tile "e05" "(setqtxlst1 (cons n3 (vl-remove n3 txlst))tulst1 (cons n1 (vl-remove n1 tulst))tulst2 (cons n2 (vl-remove n2 tulst))
lstsz (relst n1 6 lstsz)lstsz (relst n2 7 lstsz)lstsz (relst n3 8 lstsz) lstsz (relst(atof(get_tile \"e14\"))10 lstsz) lstsz (relst(atof(get_tile
\"e00\"))0 lstsz) lstsz (relst (atoi(get_tile \"e01\"))1 lstsz ) lstsz (relst(atoi (get_tile \"e02\")) 2 lstsz ) lstsz(relst(atof(get_tile \"e03\"))3
lstsz) lstsz (relst(atof(get_tile \"e04\"))4 lstsz)lstsz (relst(atof(get_tile \"e08\"))5 lstsz) )(done_dialog 3)")
(action_tile "e09" "(show)(set_tile \"e14\" (rtos (* 0.1 (getvar \"DIMASZ\")) 2 2))(set_tile \"e00\" (rtos (getvar \"DIMTXT\") 2 2))(set_tile
\"e01\" (itoa (getvar \"DIMCLRT\")))(set_tile \"e02\" (itoa (getvar \"DIMCLRD\")))(set_tile \"e03\" (rtos (getvar \"DIMASZ\") 2 2))(set_tile \"e04\" (rtos
(getvar \"DIMEXO\") 2 2))(set_tile \"e08\" (rtos (cdr (assoc 41 (tblsearch \"style\" (getvar \"TEXTSTYLE\")))) 2 2))")
(action_tile "e06" "(done_dialog 3)")
(action_tile "e10" "(setq n1 (nth (atoi$value ) tulst1)) ")
(action_tile "e11" "(setq n2 (nth (atoi$value ) tulst2)) ")
(action_tile "e12" "(setq n3 (nth (atoi$value ) txlst1)) ")
(action_tile "e07" "(setvar \"orthomode\" (rem (+ (getvar \"ORTHOMODE\") (atoi$value ) ) 2 ) ) (if (= (getvar \"ORTHOMODE\") 0) (showlst \"e07\"
'(\"关\" \"开\")) (showlst \"e07\" '(\"开\" \"关\")))")
(action_tile "e13" "(if (= (atoi $value) 1) (setq lstsz (relst (reverse (nth 9 lstsz)) 9 lstsz))) (showlst \"e13\" (nth 9 lstsz)) ")
(action_tile "e15" "(if (= (atoi $value) 1) (setq lstsz (relst (reverse (nth 11 lstsz)) 11 lstsz))) (showlst \"e15\" (nth 11 lstsz)) ")
(action_tile "e16" "(if (= (atoi $value) 1) (setq lstsz (relst (reverse (nth 12 lstsz)) 12 lstsz))) (showlst \"e16\" (nth 12 lstsz)) ")
(setq bb (start_dialog))
(unload_dialog dcl_re)
(vl-file-delete dclname)
)
)
)
(if (= bb 1)
(if (setq pt0 (getpoint "\n命令:_yb 指定第一点:"))
(progn
(princ (strcat "\n指定下一点:"))
(cond ((= (car (nth 12 lstsz))"圆点")
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 (nth 7 lstsz)) (cons 62 (nth 2 lstsz)) '
(100 . "AcDbPolyline") (cons 90 6) (cons 10 (list (- (car pt0) (* 0.25 bi (nth 3 lstsz))) (cadr pt0))) (cons 40 (* 0.5 bi (nth 3 lstsz))) (cons 41 (* 0.5 bi (nth 3 lstsz)))'(42 . 1.0)
(cons 10 (list (+ (car pt0) (* 0.25 bi (nth 3 lstsz))) (cadr pt0))) (cons 40 (* 0.5 bi (nth 3 lstsz))) (cons 41 (* 0.5 bi (nth 3 lstsz)))'(42 . 1.0)
(cons 10 (list (- (car pt0) (* 0.25 bi (nth 3 lstsz))) (cadr pt0))) '(40 . 0)'(41 . 0)'(42 . 0)(cons 10 pt0) '(40 . 0)'(41 . 0)'(42 . 0)(cons 10 pt0) (cons 40 (* bi (nth 10 lstsz))) (cons 41 (* bi (nth 10 lstsz)))
(cons 10 pt0)
)
)
)
((= (car (nth 12 lstsz))"箭头")
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 (nth 7 lstsz)) (cons 62 (nth 2 lstsz)) '
(100 . "AcDbPolyline") (cons 90 4) (cons 10 pt0) '(40 . 0.0) (cons 41 (* 0.3 bi (nth 3 lstsz)))
(cons 10 pt0) (cons 10 pt0) (cons 40 (* bi (nth 10 lstsz))) (cons 41 (* bi (nth 10 lstsz)))
(cons 10 pt0)
)
)
)
)
(setq ent1 (entget (setq name1 (entlast))))
(entmake (list '(0 . "TEXT") (cons 8 (nth 6 lstsz)) (cons 62 (nth 1 lstsz)) (cons 1 txt) (cons 10 pt0)
(cons 40 (* bi (nth 0 lstsz))) (cons 41 (nth 5 lstsz)) (cons 7 (nth 8 lstsz))
)
)
(setq ent2 (entget (setq name2 (entlast)))
w (caadr (textbox ent2))
)
(if (= kd3 1)
(progn
(entmake (list '(0 . "TEXT") (cons 8 (nth 6 lstsz)) (cons 62 (nth 1 lstsz)) (cons 1 txt1) (cons 10 (polar pt0 (* 1.5 pi)(* 1.5 (nth 0 lstsz) )))
(cons 40 (* bi (nth 0 lstsz))) (cons 41 (nth 5 lstsz)) (cons 7 (nth 8 lstsz))
)
)
(setq ent3 (entget (setq name3 (entlast)))
w1 (caadr (textbox ent3))
)))
(while (progn
(setq gr (grread t 15 0)
code (car gr)
data (cadr gr)
)
(cond
((= code 2) ; 键盘区域
(redraw)
(if (= data 15)
(if (= (getvar "ORTHOMODE") 0)
(progn
(prompt "\n命令: <正交 开>")
(setvar "orthomode" 1)
)
(progn
(prompt "\n命令: <正交 关>")
(setvar "orthomode" 0)
)
)
)
)
((= code 3) ; 鼠标左击
(setq ptlast pt
xunh nil
)
)
((= code 5) ; 鼠标移动
(if (= (getvar "ORTHOMODE") 1)
(progn
(setq x0 (car ptlast)
y0 (cadr ptlast)
x1 (car data)
y1 (cadr data)
)
(if (< (abs (- x0 x1)) (* 1.5 bi (nth 0 lstsz)))
(setq pt (list x0 y1))
(if (< (abs (- y0 y1)) (* 2 bi (nth 0 lstsz)))
(setq pt (list x1 y0))
(setq pt data)
)
)
)
(setq pt data)
)
(cond ((= (car (nth 12 lstsz))"圆点")
(entmod (reent ent1 (list nil nil nil nil pt (polar pt (if
(>
(car pt)
(car pt0)
)
0
pi
) (if (= kd3 1)(max w w1)w)
)
)
)
))
((= (car (nth 12 lstsz))"箭头")
(entmod (reent ent1 (list nil (polar pt0 (angle pt0 pt) (* bi (nth 3 lstsz))) pt (polar pt (if
(>
(car pt)
(car pt0)
)
0
pi
) (if (= kd3 1)(max w w1)w)
)
)
)
))
)
(entmod (subst
(cons 10 (list (- (car pt) (if (> (car pt) (car pt0))
0
(if (= kd3 1)(max w w1)w)
)
) (+ (cadr pt) (* bi (nth 4 lstsz)))
)
)
(assoc 10 ent2)
ent2
)
)
(if (= kd3 1)
(entmod (subst
(cons 10 (list (- (car pt) (if (> (car pt) (car pt0))
0
(max w w1)
)
) (- (cadr pt) (* bi (nth 4 lstsz))(nth 0 lstsz))
)
)
(assoc 10 ent3)
ent3
)
))
(redraw)
)
((or
(= code 11)
(= code 25)
) ; 鼠标右击
(if (and
(wcmatch txt "~*[~.0-9]*")
(= (car (nth 9 lstsz)) "开")
)
(setq txt (itoa (1- (atoi txt))))
)
(if (and
(wcmatch txt1 "~*[~.0-9]*")
(= (car (nth 11 lstsz)) "开")
)
(setq txt1 (itoa (1- (atoi txt1))))
)
(entdel name1)
(entdel name2)
(setq xunh nil)
(redraw)
)
(t
)
)
xunh
)
)
(if (and
(wcmatch txt "~*[~.0-9]*")
(= (car (nth 9 lstsz)) "开")
)
(setq txt (itoa (1+ (atoi txt))))
)
(if (and
(wcmatch txt1 "~*[~.0-9]*")
(= (car (nth 11 lstsz)) "开")
(= kd3 1)
)
(setqtxt1 (itoa (1+ (atoi txt1))))
)
)
)
)
)
(command ".UNDO" "E")
(setq *error* $orr)
(princ)
)
这个只有安装浩辰慢慢调，才知道哪些地方不支持，怎么改，很费劲。自己有兴趣就学吧。 高手才能自己调了 高手也是点滴积累来的 你都有源码，自己在gcad中调试修改即可。 浩辰 和 CAD 好多地方不一样。 同样的代码 运行顺序都不同。
页:
[1]