明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2672|回复: 5

浩辰CAD2018很多小插件都不能正常运行

[复制链接]
发表于 2019-7-7 16:33:34 | 显示全部楼层 |阅读模式
公司都是 用的过程号称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" "(setq  txlst1 (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)
              )
            (setq  txt1 (itoa (1+ (atoi txt1))))
          )
        )
      )
    )
  )
  (command ".UNDO" "E")
  (setq *error* $orr)
  (princ)
)


发表于 2019-7-7 17:56:27 来自手机 | 显示全部楼层
这个只有安装浩辰慢慢调,才知道哪些地方不支持,怎么改,很费劲。自己有兴趣就学吧。
发表于 2019-7-8 10:53:51 | 显示全部楼层
高手才能自己调了
发表于 2019-7-8 12:57:34 来自手机 | 显示全部楼层
高手也是点滴积累来的
发表于 2019-7-8 13:46:50 | 显示全部楼层
你都有源码,自己在gcad中调试修改即可。
发表于 2019-7-17 09:15:29 | 显示全部楼层
浩辰 和 CAD 好多地方不一样。 同样的代码 运行顺序都不同。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-25 17:41 , Processed in 0.194550 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表