tm20038175 发表于 2011-6-29 21:21:45

如何作块内曲线的切线？

本帖最后由 tm20038175 于 2011-6-30 16:30 编辑

这里有一个程序是可以作曲线切线的，但是块里曲线就出错了，请高手指点~~~~~

(vl-load-com)
(defun C:QX ()
    (setq $orr *error*)
    (setq *error* #err)   ;当程序出错时就会执行#err函数
      (setq os (getvar "osmode"))
(setvar "osmode" 8191)
(setq ent1(entsel (strcat "\n<画曲线上一点的切线>\n选择一条曲线<LINE>/<PLINE>/<SPLINE>/<ARC>:" )))
    ;(PRINC "\n1")
    (setq ent2 (entget(car ent1)))
   ; (PRINC "\n2")
(if (= (cdr (assoc 0 ent2)) "INSERT")
    (setq ent1 (nentselp "" (cadr ent1)))
)
    (PRINC ent1)
    ;(PRINC "\n3")
(setq ent (car ent1))
    (PRINC ent)
    ;(PRINC "\n4")
(setq curve-obj (vlax-ename->vla-object ent))

(while (setq pt (getpoint (strcat "\n<画曲线上一点的切线>\n选择曲线上一点:" )))
   ; (PRINC "\n5")
    (setq para (vlax-curve-getParamAtPoint curve-obj pt))
   ; (PRINC "\n6")
    (setq dir1 (vlax-curve-getFirstDeriv curve-obj para))
    ;(PRINC "\n7")
    (setq ang (atan (/ (cadr dir1) (car dir1))))
    ;(PRINC "\n8")
    (command "line" (polar pt (+ ang pi) 1000) (polar pt ang 1000) "")
    ;(PRINC "\n9")
(princ )
)
(setvar "osmode" os)
    (setq *error* $orr)
(princ)
)
(defun #err (s)
(setvar "osmode" os)
    (princ)
(setq *error* $orr)
)

tm20038175 发表于 2011-6-30 06:20:56

自己顶一个………………

tm20038175 发表于 2011-6-30 14:31:35

这么好的创意，不要沉啦……

tm20038175 发表于 2011-6-30 20:04:19

在顶一下~~~~~~

tm20038175 发表于 2011-7-1 11:59:58

等待高手出现………………

Gu_xl 发表于 2011-7-1 12:53:21

回复 tm20038175 的帖子


(defun C:QX (/ enl obj ent1 ent2 mat doc)
    (setq $orr *error*)
    (setq *error* #err)   ;当程序出错时就会执行#err函数
      (setq os (getvar "osmode"))
(setvar "osmode" 8191)
(setq ent1(entsel (strcat "\n<画曲线上一点的切线>\n选择一条曲线<LINE>/<PLINE>/<SPLINE>/<ARC>:" )))
    ;(PRINC "\n1")
    (setq ent2 (entget(car ent1)))
   ; (PRINC "\n2")
(if (= (cdr (assoc 0 ent2)) "INSERT")
    (progn
    (setq enl (nentselp "" (cadr ent1)))
      (setq mat (vlax-tmatrix (nth 2 enl)))
      (setq array (vla-CopyObjects
                  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
                  (vlax-make-variant
                      (vlax-safearray-fill
                        (vlax-make-safearray
                          vlax-vbobject
                          (cons 0 0)
                        )
                        (list (vlax-ename->vla-object (car enl)))
                      )
                  )
                  (vlax-get-property doc (if (= 1 (getvar 'CVPORT)) 'PaperSpace 'ModelSpace))
                  )
      )
      (vla-TransformBy (setq obj (car (vlax-safearray->list( vlax-variant-value array)))) mat)
      (setq ent1 (list (vlax-vla-object->ename obj) (cadr ent1)))
    )
)
    (PRINC ent1)
    ;(PRINC "\n3")
(setq ent (car ent1))
    (PRINC ent)
    ;(PRINC "\n4")
(setq curve-obj (vlax-ename->vla-object ent))

(while (setq pt (getpoint (strcat "\n<画曲线上一点的切线>\n选择曲线上一点:" )))
   ; (PRINC "\n5")
    (setq para (vlax-curve-getParamAtPoint curve-obj pt))
   ; (PRINC "\n6")
    (setq dir1 (vlax-curve-getFirstDeriv curve-obj para))
    ;(PRINC "\n7")
    (setq ang (atan (/ (cadr dir1) (car dir1))))
    ;(PRINC "\n8")
    (command "line" (polar pt (+ ang pi) 1000) (polar pt ang 1000) "")
    ;(PRINC "\n9")
(princ )
)
(if enl (vla-delete obj))
(setvar "osmode" os)
    (setq *error* $orr)
(princ)
)
(defun #err (s)
(setvar "osmode" os)
    (princ)
(setq *error* $orr)
)

tm20038175 发表于 2011-7-1 13:56:33

回复 Gu_xl 的帖子

高手终于出现了，Gu_xl！！！

真没想到Gu_xl把它解决了，哈哈，这么复杂的问题都解决了，本来还没抱多少希望的，真是不知道该如何感谢呀~~~~

Gu_xl 发表于 2011-7-1 15:19:49

回复 tm20038175 的帖子

请注意，对于不等比例缩放的图块，上述方法就不能使用！

tm20038175 发表于 2011-7-1 16:12:11

好的，已经很满意了，谢谢呵！………

ZZXXQQ 发表于 2011-7-1 21:13:37


;画任意曲线的切线 明经 ZZXXQQ 于建党90周年
(defun c:qx ()
(setvar "CMDECHO" 0)
(setq oldos (getvar "OSMODE"))
(setvar "OSMODE" 0)
(if (and (setq s1 (entsel "\n选择靠近曲线一点 :"))
          (setq p1 (cadr s1))
          (setq p2 (osnap p1 "NEAR"))) (progn
(setq ang (+ (angle p1 p2) (/ pi 2)))
(command "line" (polar pt (+ ang pi) 1000) (polar pt ang 1000) "")
))
(setvar "OSMODE" oldos)
(setvar "CMDECHO" 1)
(princ)
)
页: [1] 2 3
查看完整版本: 如何作块内曲线的切线？