[求助]：帮我改改这个程序谢谢

cqxt00

楼主      

--------------------------------------------------------------------------------
[求助]那位高手给我改改这个程序
(defun c:q()


(setq ff (open (setq wjm (getfiled "里程桩坐标数据文件" "" "dat" 1)) "w"))
          (setq en (car (entsel "请选择道路中心线:"))  )
  (setq m(getint"间隔桩距离：米?"))
  (setq j (getdist"起点时程："))
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;点
    (setq dat(entget en))
    (setq s(cdr (assoc 10 dat)))
   ; (command "text" "j" "mc" s ""  "起点" "")
    (command "insert" "qd" s "" "" "" )
    (setq hx(getstring "是否换向？否<2>---是<1>"))
    (if (= hx "2")
      (draw_pt)
      )
    (if (= hx "1")
      (progn
      (fx)
      (draw_pt)
      ))

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;xx

   
    (close ff)
    (startapp "notepad" wjm)
    (setvar "cmdecho" cm) (setvar "osmode" om)
    (princ)
)
  
(defun draw_pt()
   
    (command "lengthen" en "")
      (setq vob (vlax-ename->vla-object  en))
    (setq  l   (getvar "perimeter"))

    (setq n(fix(/ l m)))
    ;(setq dis (/ l n))
    (setq  i   0    )
    (repeat (1+ n)
       (setq pt  (vlax-curve-getpointatdist vob (* i m)) i (1+ i))
      (setq r(/ j 1000))
      ;;;;;判断k值
      (if (and (>= j 0)(< j 1000))
(setq f (strcat "k0+"(rtos j 2 1))))
      (if (and (>= r 1)(< r 10))
(progn
   (setq e(fix r))
(setq f(strcat "k" (itoa (fix r)) "+" (rtos (*(- r e)1000))))
   )
)
      ;;;;;;;;;判断k值end
       (princ
      
    (strcat f "," (rtos (cadr pt) 2 4) "," (rtos (car pt) 2 4) ",0
" ) ff
         
          ;(strcat (itoa i) "  " (rtos (car pt) 2 4) "  " (rtos (cadr pt) 2 4) "") ff
       )
      (setq j(+ j m))
   
   
    )
  ;;;;;;;;;;;;;;;;;;;;;;;
  ;m=2
   )


(DEFUN fx()
    (setq een(entsel));001
  (setq en(car een));002
  (setq PTS nil PTS2 nil);003
  (setq ENTS (entget En));004
  (setq EDS ENTS);005
  (while (setq ENTS (member (assoc 10 ENTS) ENTS));取出（10 x y）后面的所有值  006
    (setq PTS (append PTS (list (car ENTS) (cadr ENTS) (caddr ENTS) (cadddr ENTS))));007取出（10 X Y）后面的还有三位表元素并重新合成表
    (setq ENTS (CDR ENTS));008  取出（10 X Y）后的所有值
  );009
  (setq PTS (reverse PTS));009将007中的 PTS表中元素反倒一次 41 42 10 40
  (repeat 3 (setq PTS (append (cdr PTS) (list (car PTS)))));010 连续3次  将得到 40 10 41 42
  (foreach item PTS;011
    (if (= (car item) 42);012
      (setq item (cons 42 (- (cdr item))));013
    );014
    (setq PTS2 (append PTS2 (list item)));015
  );016
  (setq PTS PTS2);017
  (while (setq item (assoc 10 EDS));018
    (setq EDS (vl-remove item EDS));019
    (setq EDS (vl-remove (assoc 40 EDS) EDS));020
    (setq EDS (vl-remove (assoc 41 EDS) EDS));021
    (setq EDS (vl-remove (assoc 42 EDS) EDS));022
  );023
  (setq D (car (setq EDS (reverse EDS))));024
  (setq EDS (append (reverse (cdr EDS)) PTS (list D)));025
  (entmod EDS) ;026
)


程序目的:绘一条线段(pline)运行程序,输入相关设定,得到该线段的坐标.

程序中有插入图块,可以删除

我在运行时总是提示:(setq vob (vlax-ename->vla-object  en)) 错误

AyungerStudio

在函数入口的第一行加入: (vl-load-com)行。