utilitar - desenare taluz

[advex]

Pentru a reprezenta rapid un taluz in Autocad puteti utiliza un fisier lisp.

Cod [Selectează] Extinde

(defun C:SLOPE-LINE (/ Talud_boven  Talud_onder afstand afstand_totaal count p1 p2 kleur)

  (defun IS-ON-PL? (ENAME PKT /)
    (vl-catch-all-apply
      'vlax-curve-getdistatpoint
      (list
        ENAME
        PKT
        ) ;_ end of list
      ) ;_ end of vlax-curve-getDistAtPoint
    PKT
    ) ;_ end defun

(vl-load-com)

 
  (if (and (setq Talud_boven (car (entsel "\nSelect Top slope: ")))
           (setq Talud_onder (car (entsel "\nSelect Bottom slope: ")))
           (setq afstand (getint "\nLine slope distance:"))
           (setq kleur (acad_colordlg 8))
           ) ;_ end of and
   
    (progn
      (setq afstand_totaal 0)
      (setq count 0)
      (setq p1 (vlax-curve-getStartPoint
                 (vlax-ename->vla-object Talud_boven)
                 ) ;_ end of vlax-curve-getStartPoint
            ) ;_ end of setq
      (while p1
        (if (equal (/ count 2.0) (fix (/ count 2.0)) 0.001)
          (setq p2
                 (vlax-curve-getClosestPointTo
                   (vlax-ename->vla-object Talud_onder)
                   p1
                   ) ;_ end of vlax-curve-getClosestPointTo
                ) ;_ end of setq
          (setq
            p2 (MAPCAR '(LAMBDA (x) (/ x 2))
                       (MAPCAR '+
                               p1
                               (vlax-curve-getClosestPointTo
                                 (vlax-ename->vla-object Talud_onder)
                                 p1
                                 ) ;_ end of vlax-curve-getClosestPointTo
                               ) ;_ end of MAPCAR
                       ) ;_ end of MAPCAR
            ) ;_ end of setq
          ) ;_ end of if
        (entmake
          (list '(0 . "LINE")
                (cons 10 p1)
                (cons 11 p2)
                ;'(62 . 1) ; standaard kleur
                (cons 62 kleur) ; kleur dia dialog instellen

          ) ;_ end of list
        ) ;_ end of entmake
        (if
          (setq p1 (IS-ON-PL?
                     (vlax-ename->vla-object Talud_boven)
                     (vlax-curve-getpointatdist
                       (vlax-ename->vla-object Talud_boven)
                       (setq afstand_totaal (+ afstand_totaal afstand))
                       ) ;_ end of vlax-curve-getpointatdist
                     ) ;_ end of IS-ON-PL?
                ) ;_ end of setq
           p1
           ) ;_ end of if
        (setq count (1+ count))
        ) ;_ end of while
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

Fisierul este postat pe forum http://www.cadtutor.net/forum/showthread.php?t=46620 (autor: ghostware) si este disponibil la download dupa inregistrare.

Modificat de advex (13-06-2011 09:41:26)