[Kazimirovich]

Помогите плз!!!Сканирую туннель.Каждых 1.5 метра.затем EXCEL-CSV-AUTOCAD. требуют репорт на кждую секцию в pdf.
не могу заставить акад делать полилайн и ставить размер между точками измерения
и профилем тоннеля автоматически.А в ручную это ...написать макрос не хватает ни времени,ни образования...
Может кто -то уже с этим работал?Или какое-то другое решение.Есть ишшо SOLIDWORKS 2100,CIMATRON2007.

[Кулик Алексей aka kpblc]

Ничего не понял. Исходник в студию плюс результат (можно с пояснением - чего надо и как надо).

[Kazimirovich]

эадача:проставить размер точек по нормали k профилю и,как опция,соединить их полилинией.

[Олег (jr.)]

Пробуй

Код:

[Выделить все]

 (vl-load-com)
(defun csv-read(fn sep / fdesk datalist tmp)
  (setq fdesk (open fn "r"))
  (while (setq tmp (read-line fdesk))
    (setq datalist (cons (Str2List tmp sep) datalist))
    )
  (reverse datalist)
  )

;;; By John Uhden, as posted to the autodesk customization newsgroup 06 Feb 2003
(defun Str2List (str pat / i j n lst)
  (cond
    ((/= (type str)(type pat) 'STR))
    ((= str pat)'(""))
    (T
     (setq i 0 n (strlen pat))
     (while (setq j (vl-string-search pat str i))
       (setq lst (cons (substr str (1+ i)(- j i)) lst)
	     i (+ j n)
	     )
       )
     (reverse (cons (substr str (1+ i)) lst))
     )
    )
  )
;; edited by VVA
(defun text-draw (txt pnt height rotation justification)
   (if (null pnt)(command "_.-TEXT" "" txt)
   (if (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
    0.0
       ) ;_ end of =
     (progn
     ;; нулевая высота текста
       (if justification
   (command "_.-TEXT" "_J" justification "_none" pnt height rotation txt)
   (command "_.-TEXT" "_none" pnt height rotation txt)
       ) ;_ end of if
     ) ;_ end of progn
     (progn
       (if justification
   (command "_.-TEXT" "_J" justification "_none" pnt rotation txt)
   (command "_.-TEXT" "_none" pnt rotation txt)
       ) ;_ end of if
     ) ;_ end of progn
   ) ;_ end of if
     )
  (entlast)
)
(defun C:ScanPDF ( / *error* data filename numpt op points  tp x )
(defun *error* (msg)    
    (if msg (princ (strcat "\nError! " msg)))
    (princ)
    )
  (if (tblsearch "block" "23")
    (progn
 (setq filename  (getfiled "Data File" (getvar "dwgprefix") "csv" 2))
 (setq data (cdr (mapcar '(lambda(x) (cdr (mapcar 'atof x)))(setq points (csv-read filename ",")))))
 (setq numpt (caadr points))
  (setq op (getpoint "\nCenter point of tunnel: "))
  (setq data (mapcar' (lambda(x)(mapcar' + op x)) data))
  (foreach p data
    (vl-cmdf "_.-insert" "23" "_S" 0.1 "_R" 0.0 "_none" (trans p 1 0))  
      )
 (setq tp (trans (mapcar '+ op (list 0 9.69 0)) 1 0))
 (text-draw numpt tp 0.5 0.0 "BC")
 )
    (alert "Block \"23\" does not exist.\nProgram exiting...")
    )
(*error* nil)
  (princ)
  )
(C:ScanPDF)

[Kazimirovich]

и как с этим что.если копирую в sub получаю сплошной синтаксический ерор

[Олег (jr.)]

Зырь сюда
http://dwg.ru/art/8

[Kazimirovich]

спасибо,прочел.запустил.опработала.вынесла точки,но не образмерила.а мне надо РАЗМЕР от точки до профиля

[Олег (jr.)]

У тебя нет нормального профиля только набор огрызков
из арок и прямых, был бы профиль можно сделать

[Kazimirovich]

на "ОГРЫЗКИ" быстрее вешать размер.teper polilain .мне нужен пример,остальное сам доделаю.

[Олег (jr.)]

Если объединишь все отрезки и арки командой PEDIT
в одну полилинию тогда это будет работать:

Код:

[Выделить все]

 ;;==============================================================================================;;

(vl-load-com)
(defun C:SPDF ( / *error* a acsp adoc aw b data dimobj en filename ip np numpt op pline points tp txtobj uflag x)
(defun *error* (msg)
  (and uflag (vla-endundomark adoc))  
  (and msg
       (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")))
  )
  (princ)
)
  (if (tblsearch "block" "23")
    (progn (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
           (if (and (= (getvar "tilemode") 0) (= (getvar "cvport") 1))
             (setq acsp (vla-get-paperspace adoc))
             (setq acsp (vla-get-modelspace adoc))
           )
           (and uflag (setq uflag (not (vla-startundomark adoc))))
           (setq filename (getfiled "Data File" (getvar "dwgprefix") "csv" 2))
           (setq data (cdr (mapcar '(lambda (x) (cdr (mapcar 'atof x))) (setq points (csv-read filename ",")))))
           (setq numpt (caadr points))
           (setq op (trans(getpoint "\nCenter point of tunnel: ")1 0))
           (if (not (setq en (entsel "\nSelect profile: ")))
             (progn (alert "Nothing selected") (exit) (princ))
           )
           (setq pline (vlax-ename->vla-object (car en)))
           (setq data (mapcar '(lambda (x) (mapcar '+ op x)) data))
           (foreach p data
             (vl-catch-all-apply 'vlax-invoke (list acsp 'InsertBlock p "23" 0.1 0.1 0.1 0.0))
             (setq np (vlax-curve-getclosestpointto pline p))
             (setq dimobj (vl-catch-all-apply 'vlax-invoke (list acsp 'adddimaligned p np np)))
             (vl-catch-all-apply 'vlax-put (list dimobj 'stylename "100"))
            (vl-catch-all-apply 'vlax-put (list dimobj 'layer "KAV ATAZA FIN"))
           )
         (setq tp (trans (mapcar '+ op (list 0.0 9.69 0.0)) 1 0))
         (setq txtobj (vl-catch-all-apply 'vlax-invoke (list acsp 'addmtext tp 5.0 numpt)))
         (vl-catch-all-apply 'vlax-put (list txtobj 'layer "kria"))
         (vl-catch-all-apply 'vlax-put (list txtobj 'stylename "MdnPoints"))
         (vl-catch-all-apply 'vlax-put (list txtobj 'height 0.5))
         (vl-catch-all-apply 'vla-getboundingbox (list txtobj 'a 'b))
         (setq aw (- (cadr (vlax-safearray->list b)) (cadr (vlax-safearray->list a))))
         (vl-catch-all-apply 'vlax-put (list txtobj 'width aw))
         (vl-catch-all-apply 'vlax-put (list txtobj 'attachmentpoint 8))
         (setq ip (vl-catch-all-apply 'vlax-get (list txtobj 'insertionpoint)))
           (vl-catch-all-apply
             'vlax-invoke
             (list txtobj 'move (trans (mapcar '+ op (list aw 0.0 0.0)) 1 0) op)
           )
           
           (princ "\nPokey")
    )
    (alert "Block \"23\" does not exist.\nProgram exiting...")
  )
(*error* nil)
(princ)
)
(C:spdf)
;;==============================================================================================;;