ninja37 发表于 2022-5-15 21:49:52

xyp1964 发表于 2022-5-15 14:13


就是这种效果

linheyuanpcb 发表于 2022-5-15 22:47:56

ninja37 发表于 2022-5-15 21:49
就是这种效果

(entmakex (list '(0 . "CIRCLE") (cons 10 P5) (cons 40 R)))
(command "line" P5 p4"");在这个位置加入这句就有引线了

逍遥无声 发表于 2022-8-29 04:45:56

:handshake

loveu515 发表于 2022-9-28 10:32:29

我的2014怎么和燕秀有冲突呀，用了后燕秀就掉了，不知道什么原因

879053410 发表于 2022-9-29 16:45:16

收藏学习了 感谢楼主

逍遥无声 发表于 2022-10-22 01:43:40

:handshake:handshake:handshake:handshake:handshake:handshake:handshake

loveu515 发表于 2023-6-8 11:37:34

各位帮忙给看看是怎么回事？
一是退出命令时提示错误：quit / exit abort。这个倒没什么影响。
二是执行完命令后，再新建文件会提示：**express tools**-unable to load acetutil.arx ，必须重启CAD才能解决。

zwq8629 发表于 2023-7-3 15:49:16

统赢"MH"了解下

andyding 发表于 2023-7-3 21:06:08

仿写了一个，凑个热闹。
(defun c:ac (/ N OLDOR OLDOS P1        P11 P2 P22 P33 P44 PMD PP SS SSNA SSP1 X
             Y)
(setq oldos (getvar "osmode"))
(setq oldor (getvar "orthomode"))
(defun PickClosePt (obj p);;;多段线所点击点最近的一个顶点
    (setq pp (vlax-curve-getclosestpointto obj (trans p 1 0))
          n(fix (vlax-curve-getparamatpoint obj pp))
    )
    (setq p1 (vlax-curve-getPointAtParam obj n))
    (setq p2 (vlax-curve-getPointAtParam obj (1+ n)))
    (if        (< (distance pp p1) (distance pp p2))
      p1
      p2
    )
)
(princ "\n请选择要画穿线孔的多义线：")
(if (and (setq ss (entsel))
           (= (cdr (assoc 0 (entget (car ss)))) "LWPOLYLINE")
      )
    (progn
      (setvar "osmode" 0)
      (setvar "orthomode" 1)
      (setq ssna (vlax-ename->vla-object (car ss)))
      (setq ssp1 (cadr ss))
      (setq p11 (PickClosePt ssna ssp1))
      (setq pmd (mapcar '(lambda (X Y) (* (+ X Y) 0.5)) P1 P2))
      (cond ((and (= (cadr p11) (cadr pmd)) (> (car p11) (car pmd)))
             (setq p22 (list (- (car p11) 2.0) (cadr p11)))
          );;;2.0为起割点距离
          ((and (= (cadr p11) (cadr pmd)) (< (car p11) (car pmd)))
             (setq p22 (list (+ (car p11) 2.0) (cadr p11)))
          )
          ((and (= (car p11) (car pmd)) (> (cadr p11) (cadr pmd)))
             (setq p22 (list (car p11) (- (cadr p11) 2.0)))
          )
          ((and (= (car p11) (car pmd)) (< (cadr p11) (cadr pmd)))
             (setq p22 (list (car p11) (+ (cadr p11) 2.0)))
          )
      )
      (princ "\n请选择下一点：")
      (if (setq p33 (getpoint p22))
        (progn
          (cond        ((and (= (cadr p33) (cadr p22)) (> (car p33) (car p22)))
               (setq p44 (list (+ (car p22) 2.0) (cadr p22)))
                );;;2.0为起割点到穿丝孔距离
                ((and (= (cadr p33) (cadr p22)) (< (car p33) (car p22)))
               (setq p44 (list (- (car p22) 2.0) (cadr p22)))
                )
                ((and (= (car p33) (car p22)) (> (cadr p33) (cadr p22)))
               (setq p44 (list (car p22) (+ (cadr p22) 2.0)))
                )
                ((and (= (car p33) (car p22)) (< (cadr p33) (cadr p22)))
               (setq p44 (list (car p22) (- (cadr p22) 2.0)))
                )
          )
          (entmake
          (list '(0 . "LINE") (cons 10 p22) (cons 11 p44) (cons 62 1))
          )
          (entmake (list '(0 . "Circle")
                       (cons 10 p44)
                       (cons 40 0.5);;;0.5为穿丝孔半径
                       (cons 62 1)
                   )
          )
          (setvar "osmode" oldos)
          (setvar "orthomode" oldor)
        )
        (progn (princ "\n未选择到点，程序结束!")
             (setvar "osmode" oldos)
             (setvar "orthomode" oldor)
        )
      )
    )
    (progn (princ "\n未选择到图形或图形不是多义线,程序结束!")
           (setvar "osmode" oldos)
           (setvar "orthomode" oldor)
    )
)
(princ)
)

loveu515 发表于 2023-7-4 08:41:32

andyding 发表于 2023-7-3 21:06
仿写了一个，凑个热闹。

感谢分享这么好的代码
页: 1 [2] 3
查看完整版本: 线割外形穿线孔绘制