langjs的留言板 - 明经CAD社区

嘉伟钢结构 2024-4-19 08:34

您好：老师，请问一下，《45°动态轴测图工具》支持CAD2022吗？谢谢

小毛草 2022-7-31 10:50

这段程序也不支持属性块复制，
看了你的连续复制支持属性块，原来是不支持的，你是改了什么地方？

;;;;;;;;;;;;;;;;;;;;;;;;;;;;动态复制;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:qcc (/ p1 p2 s e cn fd_f dis gr cn_x)
  (prompt "动态复制n")
;__________________
(defun ttt (ss n / m)
(setq ee e
ns (ssadd)
)
(while (setq ee (entnext ee))
   (setq ns (ssadd ee ns))
)
(command "erase" ns "")
(command "copy" ss "" "m" "non" p1)
(setq m 0)
(repeat (atoi n)
   (setq m (1+ m))
   (cond
((= "/" (substr n (strlen n)))
(command
"non"
(mapcar '(lambda (x y) (+ x (* m (/ (- y x) (atof n)))))
p1
p2
)
)

)
(t
(command "non"
(mapcar '(lambda (x y) (+ x (* m (- y x)))) p1 p2)
)
)
   )
)
(command)

)
;__________________ main
(princ "\n选择要复制的物体:")
  (setq p2 nil)
  (if
(setq s (ssget))
(progn
(if(setq p1 (getpoint "\n复制的起点:"))
(setq p2 (getpoint p1 "\n复制的终点:\n")))
(setq e (entlast))
))
  (if p2
(progn
(command "copy" s "" "non" p1 "non" p2)
  (setq dis(distance p1 p2))             ;dis gr
  (setq fd_f "")
  (prompt "提示:按/切换等分复制模式,注意看左下角哦.亲..\n")
(while (or(= 5 (car(setq gr (grread  t 7 2))))(equal gr '(2 47)));(equal gr '(2 47))

  (if (equal gr '(2 47))(progn
      (if (= fd_f "")(setq fd_f "/")(setq fd_f ""))
      )
(progn
   (redraw) (grdraw p1 (cadr gr) 1)
  (if

(if (= fd_f "")
(/= cn (fix(/(distance (cadr gr) p1)dis)))
   (/= cn (fix(+(/ dis(distance (cadr gr) p1))1)))
   )
(progn
   (if (= fd_f "")
(progn(setq cn (fix(/(distance (cadr gr) p1)dis)))
   (grtext -2 (strcat "当前复制模式,共复制" (rtos cn 2 0) "个\n,间距:" (rtos dis 2 2)))
   )
(progn

(setq cn (fix(+(/ dis(distance (cadr gr) p1))1)))
(if ztmp (entdel ztmp))
(grtext -2 (strcat "当前等分模式,共复制" (rtos cn 2 0) "个,间距:" (rtos (/ dis cn) 2 2)))

;(cx-text (cadr gr) (strcat "当前等分模式,共复制" (rtos cn 2 0) "个\n") 3333)
(setq ztmp (entlast))
)
)
  (setq cn_x (rtos cn 2 0))
(setq cn_x (strcat cn_x fd_f))
   ;(atof (setq cn (getstring "\n份数(以 / 结束为等分):")))
  ;cn是字符.  "123"  "123/"
(ttt s cn_x)

)
))
))
))
(prompt "动态复制\n")
(print)
)

小毛草 2022-7-31 10:49

;_仿sketchup动态复制程序
;;这段程序如何让它支持属性快？谢谢
(defun c:ddc (/ #errormike $orr p1 p2 s e cn a1 d1 ns cnn)
;___
(defun #errormike (s)
(command ".UNDO" "E")
(setvar "osmode" snap)
(setq *error* $orr)
  )
  (setq snap (getvar "osmode"))
  (setvar "cmdecho" 0)
  (setq $orr *error*
      *error* #errormike
  )_______________
  (defun ttt (ss n / m)
(setq ee e
   ns (ssadd)
)
(while (setq ee (entnext ee))
   (setq ns (ssadd ee ns))
)
(command "erase" ns "")
(command "copy" ss "" "m" "non" p1)
(if (member (substr n (strlen n)) '("/" "*"))
   (progn
(setq m 0)
(repeat (atoi n)
   (setq m (1+ m))
   (cond
      ((= "/" (substr n (strlen n)))
      (command "non"(mapcar '(lambda (x y) (+ x (* m (/ (- y x) (atof n))))) p1 p2))
      )
      ((= "*" (substr n (strlen n)))
      (command "non"(mapcar '(lambda (x y) (+ x (* m (- y x)))) p1 p2))
      )
   )
)
   )
   (command "non" (setq p2 (polar p1 a1 (atof n))))
)
(command)
  )
;__________________
  (princ "\n动态复制程序")
  (princ "\n选择要复制的物体:")
  (setq s (ssget))
  (setq p1 (getpoint "\n复制的起点:"))
  (command "undo" "be" "line" p1 p1 "" )
  (setq e (entlast) )
  (command "copy" s "" "non" p1 pause)
  (setq p2 (getvar "lastpoint")
a1 (angle p1 p2)
d1 (distance p1 p2)
  )
  (setq cn "1*")
  (while cn
(ttt s cn)
(initget 128)
(princ "\n输入坐标=复制终点                      输入数值=修改间距 ")
(princ "\n输入数值n并以 / 结束=间距内等分n次复制输入数值n并以 * 结束=按间距复制n次 ")
(setq cnn (getpoint "\n请按提示输入<退出>:"))
(if (= 'LIST (type cnn))
   (setq p2 cnn
      a1 (angle p1 p2)
      d1 (distance p1 p2)
   )
   (setq cn cnn)
)
  )
  (entdel e)
  (command "undo" "e")
  (princ)
)

ninja37 2022-6-3 11:43

langjs大师你好，我想要一个连续移动的命令跟这个连续复制2.0一样的原理的，移动的时候默认是3mm正交移动。。。可以设置移动距离。大师能不能抽点时间编写一个。

5d95286278 2021-12-26 21:45

你好，您做的PCCAD明细表汇总的源码能发下吗？感谢，邮箱：jkf021@Foxmail.com，一直用您做的TH++，很好用，程序里默认的存放目录文件夹权限不够，无法写入临时存放的文件，导致运行出错，需要改个目录

电赛加油 2020-10-27 18:57

大神，我问一下哈：“文本递增刷源码，我刷我刷我刷刷刷！(更新支持属性块) ” 压缩包下载解压出现错误，怎么解决哇？

kexiya123 2016-10-9 13:44

找到了，“在命令行输入FILEDIA,把值设为1.这样下次重启CAD就会跳出对话框了“，多亏了度娘！

kexiya123 2016-10-9 13:39

刚下了你的PLDY程序，但是退出来后，点击打开文件夹图标，命令栏老是显示“输入要显示的文件名”，打印程序已经删除掉还是这样的，不胜其烦，怎么破！

xiaomm250 2016-1-20 14:43

博士??????????

梦醒才知原是梦 2014-11-28 10:28

langjs 关于您发的批量打印PLDY.VLX能否添加进去多个图块打印的顺序，例如先上下，后左右这样的选项，还有批量打印图纸列表中显示:命令: Prin 未知命令“PRIN”。按 F1 查看帮助。的问题麻烦也帮忙处理下如果可以麻烦发给我的邮箱598883056，麻烦了

theisland 2014-9-21 21:14

狼大侠，您那画轴测图的工具很好用，但是画直线那个命令有点不科学哦，轴侧图中是有水平直线的呀，能否增加水平方向的角度？http://bbs.mjtd.com/thread-92999-1-1.html

chenbh2 2014-8-4 21:13

大虾动态引线非常不错,对我工作有很大的帮助!
请帮修改下
一:宽度比例默认0.7
二:数字递增,对有文字的数字在后面递增
不胜感谢!!!!!!
如有空帮忙,请发邮箱sjcbh@189.cn

simpleye 2014-5-7 13:35

[原创]一个图层工具
这个图层工具不见下载地址了，可以传给我一份吗？ss20041211@126.com

峰峰兒 2013-8-29 20:19

下載，仿word文本查找和替換，用於單行文本和多行文本。
指令: CZHTH
; 錯誤: 損壞的引數類型: numberp: nil    可以指導小第一下
;;; =============================================== ==================
;;;文本查找和替換,核心代碼來自風之影。程序顯示多行文本換行位置不理想
;;;作者：langjs命令：ttf日期2011年12月
;;; ======================== =========================================
(defun c:czhth (/ bb bb_bak box dcl_pt en ennn ent ent1 f1 f2 hijk lst01 n newchln newtxt np1 np2 np3 np4 oldchln p p1x p1y p2x p2y
  px py r readch s schct snap ss ss1 txt txt00 txt00ln txt01 txtln ty w
   )
  (defun czth-01 (/ index_value) ;顯示對話框
(setq index_value (load_dialog "TTF.dcl"))
(new_dialog "TTF1" index_value "" dcl_pt)
(if oldch
   (set_tile "e01" oldch)
   (set_tile "e01" "")
)
(if newch
   (set_tile " e02" newch)
   (set_tile "e02" "")
)
(if (= bb_bak 4)
   (set_tile "e03" "當前選擇")
   (set_tile "e03" "整個圖形")
)
(mode_tile "e06" 1)
(action_tile "e04" "(czth-03) (setq dcl_pt (done_dialog 4)) ")
(action_tile "e05" "(czth-03) (setq dcl_pt (done_dialog 1)) ")
(action_tile "e06" "(czth-03 ) (setq dcl_pt (done_dialog 2)) ")
(action_tile "e07" "(czth-03) (setq dcl_pt (done_dialog 3)) ")
(setq bb (start_dialog))
  )
  (defun czth-02 (/ index_value) ;顯示對話框
(setq index_value (load_dialog "TTF.dcl"))
(new_dialog "TTF2" index_value "" dcl_pt)
(if oldch
   (set_tile "e01" oldch)
   (set_tile "e01" "")
)
(if newch
   (set_tile " e02" newch)
   (set_tile "e02" "")
)
(if (= bb_bak 4)
   (set_tile "e03" "當前選擇")
   (set_tile "e03" "整個圖形")
)
(action_tile "e04" "(czth- 03) (setq dcl_pt (done_dialog 4)) ") ;選擇
(action_tile "e05" "(czth-03) (setq dcl_pt (done_dialog 1)) ") ;查找
(action_tile "e06" "(czth-03) (setq dcl_pt (done_dialog 2)) ") ;替換
(action_tile "e07" "(czth-03) (setq dcl_pt (done_dialog 3)) ") ;全部替換
(action_tile "e08" "(czth-03) (setq dcl_pt (done_dialog 5)) ") ;平移
(setq bb (start_dialog))
(if (= bb 5) ;如按平移
   (progn
(getpoint "\n中鍵平移，左鍵或右鍵平移結束:")
(princ "\n ")
(czth-02)
   )
)
  )
  (defun czth-03 ()
(setq oldch (get_tile "e01"))
(setq newch (get_tile "e02"))
  )
  (defun czth-04 (en / ss)
(if en
   (progn
(setq ss (ssadd))
(while (setq en (entnext en))
(if (not (member (cdr (assoc 0 (entget en))) '("ATTRIB" "VERTEX"
   "SEQEND"
   )
   )
   )
   (ssadd en ss)
)
)
(if (zerop (sslength ss))
(setq ss nil)
)
ss
   )
   (ssget "_x")
)
  )
  (setvar "cmdecho" 0) ;關閉命令響應
  (command ".UNDO" "BE") ;設置undo起點
  (setq snap (getvar "osmode"))
  (setvar "osmode" 0) ;關閉捕捉
  (if (null dcl_pt)
(setq dcl_pt '(-1 -1))
  )
  (czth-01 )
  (if (= bb 4)
(progn
   (setq bb_bak bb
   ss (ssget '((0 . "TEXT,MTEXT")))
   ) ;選擇文字
   (czth-02)
)
(setq ss (ssget "X" '( (0 . "TEXT,MTEXT")))) ;選擇文字
  )
  (if ss
(progn
   (setq i 0
   j 0
   k 0
   oldchln (strlen oldch)
   newchln (strlen newch)
   )
   (while (< i (sslength ss))
(setq ent (entget (ssname ss i))
   ty (cdr (assoc 0 ent))
   txt (cdr (assoc 1 ent))
   txtln (strlen txt)
   schct 1
   newtxt ""
   ss1 (ssadd)
   i (1+ i)
)
(while (<= schct txtln)
(if (member bb '(1 2 3 4 5))
   (princ)
   (progn
   (command ".erase" ss1 "")
   (command ".UNDO" "E") ;設置undo終點
   (vl-exit-with-error "")
   )
)
(if (= (setq readch (substr txt schct oldchln))
oldch
   )
   (progn
   (if (= ty "MTEXT")
  (progn
(command "copy" (cdr (assoc -1 ent)) "" '(0.0 0.0 0.0) '(0.0 0.0 0.0))
(setq ennn (entlast))
(command ".EXPLODE" ennn)
(setq ss1 (czth-04 ennn)
ent1 (entget ( ssname ss1 0))
p (cdr (assoc 10 ent1)) ;文本基點坐標
h (cdr (assoc 40 ent1)) ;文本高度
w (cdr (assoc 41 ent1)) ;文本寬高比
s (cdr (assoc 7 ent1)) ;文本式樣
r (cdr (assoc 50 ent1)) ;文本旋轉角度
)
(setq ty "")
  )
   )
   (if (= ty "TEXT")
  (setq p (cdr (assoc 10 ent)) ;文本基點坐標
      h (cdr (assoc 40 ent)) ;文本高度
      w (cdr (assoc 41 ent)) ;文本寬高比
      s (cdr (assoc 7 ent)) ;文本式樣
      r (cdr (assoc 50 ent)) ;文本旋轉角度
  )
   )
   (command ".erase" ss1 "")
   (setq lst01 (czth-05 newtxt))
   (setq n (car lst01))
   (setq txt00 (cdr lst01))
   (setq txt00ln (strlen txt00))
   ( setq box (textbox (list (cons 1 txt) (cons 40 h) (cons 41 w) (cons 7 s)))) ;文本框坐標
   (setq p1x (car (car box)) ;文本左下角x坐標
   p1y (cadr (car box))
   p2x (car (cadr box)) ;文本右上角x坐標
   p2y (cadr (cadr box))
   px (car p)
   py (cadr p)
   f1 (* txt00ln (/ (- p2x p1x) txtln))
   f2 (* (+ (+ txt00ln 0.5) oldchln) (/ (- p2x p1x) txtln))
   np1 (list (+ f1 px) (- (+ p1y py) (* nh 1.8424)))
   np2 (list (+ f2 px) (- (+ p1y py) (* nh 1.8424)))
   np3 (list (+ f2 px) (- (+ p2y py) (* nh 1.8424)))
   np4 (list (+ f1 px) ( - (+ p2y py) (* nh 1.8424)))
   np1 (polar p (+ r (angle p np1)) (distance p np1))
   np2 (polar p (+ r (angle p np2)) (distance p np2) )
   np3 (polar p (+ r (angle p np3)) (distance p np3))
   np4 (polar p (+ r (angle p np4)) (distance p np4))
   ) ;下面程序進行屏幕縮放計算
   (command " PLINE" np1 "w" (* h 0.1) (* h 0.1) np2 np3 np4 "c")
   (setq en (entlast))
   (command "_.change" en "" "p" "c" 1 "")
   (setq px (car np1)
   py (cadr np1)
   np1 (list (- px (* h 15)) (- py (* h 13)) 0.0) ;縮放窗口計算與字體高度關聯
   np2 (list (+ px ( * h 15)) (+ py (* h 7)) 0.0)
   )
   (if (or ;如按的不是全部替換則縮放窗口
   (= bb 1)
   (= bb 2)
)
  (progn
(command "zoom" " W" np1 np2)
(czth-02)
  )
   )
   (command "erase" en "")
   (if (= bb 1) ;如按查找
  (setq j (1+ j)
      schct (+ schct oldchln)
      newtxt (strcat newtxt oldch)
  )
   )
   (if (= bb 2) ;如按替換
  (progn
(setq j (1+ j)
txt (strcat newtxt newch (substr txt (+ schct oldchln)))
txtln (strlen txt)
schct (+ schct newchln )
newtxt (strcat newtxt newch)
k (1+ k)
)
(entmod (setq ent (subst
      (cons 1 txt)
      (assoc 1 ent)
      ent
      )
   )
)
  )
   )
   (if (= bb 3) ;如按全部替換
  ( progn
(setq i 0
oldchln (strlen oldch)
newchln (strlen newch)
)
(while (< i (sslength ss))
   (setq ent (entget (ssname ss i))
   txt (cdr (assoc 1 ent))
   txtln (strlen txt )
   schct 1
   newtxt ""
   i (1+ i)
   )
   (while (<= schct txtln)
      (if (= (setq readch (substr txt schct oldchln))
      oldch
   )
(progn
   (setq j (1+ j)
txt (strcat newtxt newch (substr txt (+ schct oldchln)))
txtln (strlen txt)
schct (+ schct newchln)
newtxt (strcat newtxt newch)
k (1+ k)
   )
   (entmod (setq ent (subst
         (cons 1 txt)
         (assoc 1 ent)
         ent
      )
   )
   )
   (princ)
)
(setq schct (1+ schct)
      newtxt (strcat newtxt (substr readch 1 1))
)
      )
   )
)
  )
   )
   )
   (setq schct (1+ schct)
newtxt (strcat newtxt ( substr readch 1 1))
   )
)
)
   )
)
  )
  (princ (strcat "\n已完成了搜索，共找到了" (itoa j) "處，並已完成了" (itoa k) "處替換。") )
  (alert (strcat "\n已完成了搜索，共找到了" (itoa j) "處，並已完成了" (itoa k) "處替換。"))
  (setvar "osmode" snap) ;恢復捕捉
  (command ".UNDO" "E") ;設置undo終點
  (princ)
)
(defun czth-05 (newtxt / i readch schct txt01 txtln)
  (setq txtln (strlen newtxt)
i 0
schct 1
txt01 ""
  )
  (while ( <= schct txtln)
(setq readch (substr newtxt schct 2))
(if (= readch " \\P ")
   (progn
(setq i (1+ i))
(setq schct (+ schct 2))
(setq txt01 " ")
   )
   (progn
(setq schct (1+ schct))
(setq txt01 (strcat txt01 (substr readch 1 1)))
   )
)
  )
  (cons i txt01)
) 對話框文件在下邊

TTF.dcl
0 Bytes, 下載次數: 204
點評