newer的留言板 - 晓东CAD家园-论坛

/db_自贡黄明儒_ 2016-11-7 11:45

你的QQ是多少呢？我的740688321

WhoCanSay 2016-8-1 15:00

怎么搜不到你的函数xdrx_document_getprec是怎么写的？

SCWDB809 2016-7-29 16:06

在CAD下运行有关开源函数是否需要其他插件支持，比如在CAD命令行输入：(XD::GEOM:NUMDIV 12 2 3)，提示Error: no function definition: XD::GEOM:NUMDIV。若各CAD版本需要函数库支持，应在哪里下载？谢谢

zlc409057173 2016-7-26 17:13

你好，我想请问你几个关于dwg图上用java API获取数据的问题，就是我用
OdDbDatabase localOdDbDatabase = null;
if (!appServices.findFile(fileName).isEmpty()) {
localOdDbDatabase = appServices.readFile(fileName);
OdDbBlockTable pTable = (OdDbBlockTable) localOdDbDatabase.getBlockTableId().safeOpenObject(OpenMode.kForWrite, false);这种取dwg上的数据，但是这样取会把图纸空间的数据都取出来，而我只想要模型空间的数据，请问有什么标志，或者有什么方法吗？？

/db_自贡黄明儒_ 2016-4-14 11:32

我遇到难题了，能不能帮一把？幻灯片总是装不满对话框（大致装满）

zhuqiqing 2015-1-4 17:02

newer大师请帮忙：轴号图块中的轴号文字编排方式为：xx-xx，比如是12-03,求可一次选择修改多个轴号的前半部分或后半部分局部文字，例如将12-03和12-04统一修改为05-03和05-04，要求可以多选和框选轴号图块，包括可修改图块中文字和履性字，含嵌套块.先行谢过了!

/db_自贡黄明儒_ 2014-12-11 16:52

entmake怎么插入属性块，我搞不定了？

lch8526 2014-12-6 10:59

请帮忙修改这个程序
http://bbs.xdcad.net/thread-677802-1-1.html
(出处: 晓东CAD家园-论坛)

lch8526 2014-12-6 10:58

(defun c:h11 ()
  (setq v1 (getvar "osmode"))             ; 获取当前的目标捕捉类型，将其赋给变?
                                    ; 縱1
  (setq v2 (getvar "cmdecho"))             ; 获取当前的普通命令提示状态，将其赋?
                                    ; ?淞縱2
  (setq v3 (getvar "clayer"))             ; 获取当前的图层，将其赋给变量v3
  (setvar "osmode" 0)                      ; 关闭目标捕捉状态
  (setvar "cmdecho" 0)                      ; 不显示普通命令的提示
  (command "layer" "m" "剖面线" "") ; 设置当前图层为剖面线
  (while (or (setq pt (getpoint "\n拾取内部点<选择边界>："))
      (progn
         (prompt "\n选取边界<退出>:")
         (setq pt (ssget))
      )
   )
(progn
   (if (= (type pt) 'LIST)
      (command "bhatch" "p" "line" 1 45 pt ) ; 填充
      (command "bhatch" "p" "line" 1 45 "s" pt ) ; 填充
   )
   (while (= (getvar "cmdactive") 1)
      (command "")
   )
)
  )
  (setvar "osmode" v1)                      ; 恢复目标捕捉的原来状态
  (setvar "cmdecho" v2)                      ; 恢复普通命令提示原来的显示状态
  (setvar "clayer" v3)                      ; 恢复图层
  (princ)
)

请问你这个程序能不能改为拾取多个内部点时变为一个整体的填充？

aimisiyou 2014-11-29 19:05

有个问题想请教下你啊

friendfgj 2014-11-11 09:47

[php]
;;点换块晓东 zxq0220 2008.4.8
(defun c:tat ()
(setvar "CMDECHO" 0)
(setq oldos (getvar "OSMODE"))
(setq blknm (getstring "\nBlock Name :"))
(if (setq ss (ssget '((0 . "POINT")))) (progn
  (setvar "OSMODE" 0)
  (setq i -1)
  (repeat (sslength ss)
(setq en (ssname ss (setq i (1+ i)))
      ent (entget en)
      pt (cdr (assoc 10 ent)))
(command ".insert" blknm pt "" "" "")
  )
  (command ".erase" ss "")
))
(setvar "OSMODE" oldos)
(setvar "CMDECHO" 1)
(princ)
)
[/php]

这是一个将点替换为块的小程序，能麻烦改一下，改成将块替换为点吗？
friendfgj@163.com，多谢

/db_自贡黄明儒_ 2013-8-22 14:11

搞定了，还是要谢谢你，你是我最后的精神支柱!!

/db_自贡黄明儒_ 2013-8-22 13:55

你好，我正调试一个程序，按线型选择就出错了，有没有空帮我看看该怎么写，不用感激
(defun C:Lens1 (/ COLOR EN FIL LAYLIS LEN LINETYPE NAME OSM1 RA0 RA1 RA2 RA3 RA4 RA5 RA6 RA7 RETURN# SS0)
  ;;0 错误处理
  (defun *error* (S)
(vl-bt)
;;结束编组;(if (= 8 (logand (getvar "undoctl") 8)) (command "_.undo" "_e"))
(endundo)
;;结束命令
(while (not (equal (getvar "cmdnames") "")) (command nil))
(if osm1
   (setvar "osmode" osm1)
)
(princ "\n 出错啦!")
  )
  ;;1.1 获取颜色
  (defun getcolor (/ COLOR EN ENTLIST LAYER)
(while (not en) (setq en (car (entsel "\n 拾取颜色"))))
(setq entlist (entget en))
(if (setq color (cdr (assoc 62 entlist)))
   nil
   (progn
(setq layer (cdr (assoc 8 entlist)))
(setq color (cdr (assoc 62 (tblsearch "layer" layer))))
   )
)
(list en color)
  )
  ;;1.2 指定颜色的随层随块层名
  (defun ColorLayers (color / D LAYER LAYLIS)
(while (setq d (tblnext "LAYER" (null d)))
   (setq layer (cdr (assoc 2 d)))
   (if (equal (cdr (assoc 62 d)) color)
(setq layLis (if layLis
         (strcat layLis "," layer)
         layer
      )
)
   )
)
LAYLIS
  )
  ;;2 取得层名
  (defun getLayer ()
(list (assoc 8 (entget (car (entsel "\n 拾取层名")))))
  )
  ;;3.1 获取线型
  ;;EN LINETYPE
  (defun getLineType (/ ENTLIST LAYER)
(while (not en) (setq en (car (entsel "\n 拾取线型"))))
(setq entlist (entget en))
(if (setq LineType (cdr (assoc 6 entlist)))
   nil
   (progn
(setq layer (cdr (assoc 8 entlist)))
(setq LineType (cdr (assoc 6 (tblsearch "layer" layer))))
   )
)
  )
  ;;3.2 指定线型的随层随块层名
  ;; LAYLIS
  (defun TypeLayers (LineType / D LAYER)
(while (setq d (tblnext "LAYER" (null d)))
   (setq layer (cdr (assoc 2 d)))
   (if (equal (cdr (assoc 6 d)) LineType)
(setq layLis (if layLis
         (strcat layLis "," layer)
         layer
      )
)
   )
)
  )
  ;;4 一统+ strcat
  ;;在处理输入时，可能有些用处自贡黄明儒 2013年8月20日
  ;;(++ '("a" 5));"a5"
  (defun ++ (lis / SYMBOL X)
(if (vl-every 'numberp lis)
   (apply '+ lis)
   (apply 'strcat (mapcar 'vl-princ-to-string lis))
)
  )
  ;;5.1 圆整线宽
  (defun Iwidth (len0)
(cond ((< len0 5) (setq len 5))
   ((< len0 9) (setq len 9))
   ((< len0 13) (setq len 13))
   ((< len0 15) (setq len 15))
   ((< len0 18) (setq len 18))
   ((< len0 20) (setq len 20))
   ((< len0 25) (setq len 25))
   ((< len0 30) (setq len 30))
   ((< len0 35) (setq len 35))
   ((< len0 40) (setq len 40))
   ((< len0 50) (setq len 50))
   ((< len0 53) (setq len 53))
   ((< len0 60) (setq len 60))
   ((< len0 70) (setq len 70))
   ((< len0 80) (setq len 80))
   ((< len0 90) (setq len 90))
   ((< len0 100) (setq len 100))
   ((< len0 106) (setq len 106))
   ((< len0 120) (setq len 120))
   ((< len0 140) (setq len 140))
   ((< len0 158) (setq len 158))
   ((< len0 200) (setq len 200))
   (t (setq len 211))
)
  )
  ;;5.2 预设线宽
  ;; len
  (defun PreWidth (en / ENTLIST LEN1 OBJ)
;;(setq en (car (entsel)))
(setq entlist (entget en))
(setq len (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)))
(setq len (/ len 20))
(Iwidth len)    ;圆整后len
(setq obj (vlax-ename->vla-object en))
(vla-put-Lineweight obj len)
(princ (++ (list "\n 当前线宽是 " len)))
(initget (++ (list 2 4)))    ;没必要也用一下
(if (setq len1 (getreal (++ (list "\n 输入线宽<" len ">"))))
   (progn (Iwidth len1)
      (vla-put-Lineweight obj len)
   )
)
(princ (++ (list "\n 当前线宽圆整后是 " len)))
  )
  ;;5.3 处理选择集内对象
  (defun HHproSS (ss len / EN N)
(repeat (setq n (sslength ss))
   (setq en (ssname ss (setq n (1- n))))
   (setq en (vlax-ename->vla-object en))
   (vlax-put en 'lineweight len)
)
  )
  ;;6.1 对话框
  (defun MyPlanDCL (/ DCLID FN FNAME LIN return#)
(setq fname (vl-filename-mktemp nil nil ".dcl"))
(setq fn (open fname "w"))
(write-line "MyPlanDialog : dialog{" fn)
(write-line "label=\"自贡运机集团黄明儒命令:Lens\";" fn)
(write-line " :row{" fn)
(write-line "  :column{" fn)
(write-line "  :boxed_radio_column{label=\"选择\";" fn)
(write-line " initial_focus=\"ra1\";" fn)
(write-line
   " :radio_button{label=\"按图层(&0)\";key=\"ra0\";mnemonic=\"0\";}"
   fn
)
(write-line
   " :radio_button{label=\"按颜色(&1)\";key=\"ra1\";mnemonic=\"1\";value=\"1\";}"
   fn
)
(write-line
   " :radio_button{label=\"按线型(&2)\";key=\"ra2\";mnemonic=\"2\";}    "
   fn
)
(write-line " }" fn)
(write-line " :boxed_radio_column{label=\"范围\";" fn)
(write-line " initial_focus=\"ra3\";" fn)
(write-line
   " :radio_button{label=\"手选(&3)\";key=\"ra3\";mnemonic=\"3\";value=\"1\";}"
   fn
)
(write-line
   " :radio_button{label=\"全选(&4)\";key=\"ra4\";mnemonic=\"4\";}    "
   fn
)
(write-line " }" fn)
(write-line " }//column" fn)
(write-line "  :column{" fn)
(write-line "  :boxed_radio_column{label=\"功能\";" fn)
(write-line " initial_focus=\"ra5\";" fn)
(write-line
   " :radio_button{label=\"统计线长(&5)\";key=\"ra5\";mnemonic=\"5\";value=\"1\";}"
   fn
)
(write-line
   " :radio_button{label=\"线宽显示(&6)\";key=\"ra6\";mnemonic=\"6\";}"
   fn
)
(write-line
   " :radio_button{label=\"保存文件(&7)\";key=\"ra7\";mnemonic=\"7\";}    "
   fn
)
(write-line " }" fn)
(write-line " :boxed_column{label=\"操作\";" fn)
(write-line
   " : button {label = \"取消(&E)\";key = \"but_Cancel\";is_cancel=true;}"
   fn
)
(write-line
   " : button {label = \"确定(&O)\";key = \"but_OK\";is_default=true;}"
   fn
)
(write-line " } " fn)
(write-line "  }//column" fn)
(write-line " }" fn)
(write-line "}" fn)
(close fn)
(setq fn (open fname "r"))
(setq dclid (load_dialog fname))
(while
   (or (eq (substr (setq lin (vl-string-right-trim
   "\" fn)"
   (vl-string-left-trim "(write-line \"" (read-line fn))
)
      )
      1
      2
      )
      "//"
   )
   (eq (substr lin 1 (vl-string-search " " lin)) "")
   (not (eq (substr lin (+ (vl-string-search " " lin) 1) 9)
   " : dialog"
         )
   )
   )
)
(new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)
(action_tile "but_OK" "(MyPlanGet)(done_dialog 1)")
(setq return# (start_dialog))
(unload_dialog dclid)
(close fn)
(vl-file-delete fname)
return#
  )
  ;;6.2 对话框上用户选择
  (defun MyPlanGet ()
(setq ra0 (get_tile "ra0"))
(setq ra1 (get_tile "ra1"))
(setq ra2 (get_tile "ra2"))
(setq ra3 (get_tile "ra3"))
(setq ra4 (get_tile "ra4"))
(setq ra5 (get_tile "ra5"))
(setq ra6 (get_tile "ra6"))
(setq ra7 (get_tile "ra7"))
  )
  ;;7 线长统计
  (defun HH:lens (ss / LENS SSV n)
(command "_.Select" ss "")
(setq ssv (vla-get-activeselectionset
(vla-get-activedocument (vlax-get-acad-object))
      )
)
(setq n 0)
(setq lens 0)
(vlax-for x ssv
   (setq
lens (++
         (list lens
      (vlax-curve-getdistatparam x (vlax-curve-getendparam x))
         )
      )
   )
   (setq n (1+ n))
)
(if ssv
   (vlax-release-object ssv)
)
(princ (++ (list "\n 线数量(" n ") 总长为: " lens)))
(princ)
  )
  ;;8.1
  ;;137.2 [功能] 图中最后图元Find True last entity
  (Defun MJ:LASTENT (/ E0 EN)
(Setq E0 (EntLast))
(While (Setq EN (EntNext E0)) (Setq E0 EN))
E0
  )
  ;;8.2
  ;;125.2 [功能] 获取在图元 en 之后产生的图元的选择集
  (defun MJ:ss-entnext (en / ss)
(if en
   (progn
(setq ss (ssadd))
(while (setq en (entnext en))
   (if (not (member (cdr (assoc 0 (entget en)))
   '("ATTRIB"
      "VERTEX"
      "SEQEND"
      )
   )
      )
      (ssadd en ss)
   )
)
(if (zerop (sslength ss))
   (setq ss nil)
)
ss
   )
   (ssget "_x")
)
  )
  ;;8.3 另存
  (defun HH:save (ss name / DNAME LASTENT NEWDNAME SS0)
(setq lastent (MJ:LASTENT))
(command "_.copy" ss "" "0,0" "@")
(setq ss0 (MJ:ss-entnext lastent))
(setq DName (getvar "dwgname"))
(setq NewDName (++ (list (vl-filename-base DName) "-" name)))
;;保证文件名不重复
(while (findfile (++ (list NewDName ".dwg")))
   (setq NewDName (++ (list NewDName "-" name)))
)
(command "_.WBLOCK" NewDName "" "0,0" ss0 "")
(princ (++ (list "\n 已经保存,文件名为:" NewDName)))
  )
  ;;9.1 编组开始;(command "_.undo" "be")
  (defun startundo (*DOC*)
(vla-startundomark *DOC*)
  )
  ;;9.2 编组结束(command "_.undo" "e")
  (defun endundo (*DOC*)
(while (= 8 (logand 8 (getvar 'undoctl)))
   (vla-endundomark *DOC*)
)
  )
  ;;10 执行操作
  (defun MyPlanDo ()
(cond ((= ra7 "1")    ;局部保存
   (cond ((= ra0 "1")    ;//按图层
   (setq fil (getLayer))
   )
   ((= ra1 "1")    ;//按颜色
   (setq color (getcolor))
   (setq en (car color))
   (setq color (cadr color))
   (setq layLis (ColorLayers color)) ;获得层
   (setq fil (list '(-4 . "<OR")
   (cons 62 color)
   '(-4 . "<AND")
   (cons 8 layLis)
   '(-4 . "<OR")
   (cons 62 0)
   (cons 62 256)
   '(-4 . "OR>")
   '(-4 . "AND>")
   '(-4 . "OR>")
      )
   )
   )
   ((= ra2 "1")    ;//按线型
   (getLineType)
   (TypeLayers LineType)
   (setq fil (list '(-4 . "<OR")
   (cons 6 LineType)
   '(-4 . "<AND")
   (cons 8 layLis)
   (cons 6 "~*")
   '(-4 . "AND>")
   '(-4 . "OR>")
      )
   )
   )
   )
   )
   (T    ;显示or统计线长
   (cond ((= ra0 "1")
   (setq fil (cons (cons 0 "ARC,*LINE,CIRCLE,ELLIPSE") (getLayer)))
   )
   ((= ra1 "1")
   (setq color (getcolor))
   (setq en (car color))
   (setq color (cadr color))
   (setq layLis (ColorLayers color)) ;获得层
   (setq fil (list '(-4 . "<AND")
   (cons 0 "ARC,*LINE,CIRCLE,ELLIPSE")
   '(-4 . "<OR")
   (cons 62 color)
   '(-4 . "<AND")
   (cons 8 layLis)
   '(-4 . "<OR")
   (cons 62 0)
   (cons 62 256)
   '(-4 . "OR>")
   '(-4 . "AND>")
   '(-4 . "OR>")
   '(-4 . "AND>")
      )
   )
   )
   ((= ra2 "1")
   (getLineType)
   (TypeLayers LineType)
   (setq fil (list '(-4 . "<AND")
   (cons 0 "ARC,*LINE,CIRCLE,ELLIPSE")
   '(-4 . "<OR")
   (cons 6 LineType)
   '(-4 . "<AND")
   (cons 8 layLis)
   (cons 6 "~*")
   '(-4 . "AND>")
   '(-4 . "OR>")
   '(-4 . "AND>")
      )
   )
   )
   )
   )
)
;;(setvar "nomutt" 1)
(cond ((= ra6 "1")    ;线宽显示
   (setvar "lwdisplay" 1)
   (PreWidth en)
   )
)

(cond ((= ra3 "1") (setq ss0 (ssget fil)))    ;手选
   ((= ra4 "1") (setq ss0 (ssget "X" fil))) ;全选
)
;;(setvar "nomutt" 0)
(if ss0
   (cond ((= ra5 "1") (HH:lens ss0))    ;统计线长
      ((= ra6 "1") (HHproSS ss0 len))    ;线宽显示
      ((= ra7 "1")
      (cond ((= ra0 "1") (setq name (cdr (car fil))))
   ((= ra1 "1") (setq name color))
   ((= ra2 "1") (setq name LineType))
      )
      (HH:save ss0 name)
      )    ;保存文件
   )
   (gc)
)
  )
  ;;11 本程序主程序
  (vl-load-com)
  ;; *DOC*常用，故设置成全局，带*时VL编辑器会排在前面，易于去除
  (if *DOC*
nil
(setq *DOC* (vla-get-activedocument (vlax-get-acad-object)))
  )
  (setq osm1 (getvar "osmode"))
  (setvar "osmode" 0)
  (startundo *DOC*)    ;可能对wblock无效
  (setq RETURN# (MyPlanDCL))    ;执行对话框，取得用户选择
  (if (= RETURN# 1)
(MyPlanDo)
(gc)
  )
  (endundo *DOC*)
  (setvar "osmode" osm1)
  (if ss0
(command "_.Select" ss0 "")
  )
  (princ)
)

pengfei2010 2013-7-23 18:22

你好你的qq号码多少呀向你请教

newer的个人空间 http://bbs.xdcad.net/?5280 [收藏] [复制] [分享] [RSS]

留言板

newer