Recent Posts

Pages: [1] 2 3 ... 10
1
AutoLISP (Vanilla / Visual) / Pressure Pipe Network Civil 3D
« Last post by mailmaverick on Today at 01:38:40 PM »
Anyone working here on pressure pipe networks in Civil 3D ?

I have a drawing containing multiple LINES having different Z-coordinate of Start and End Points, representing start and end elevations. Also, each line has pipe diameter data stored in form of Object Tables (GIS Data). All the LINES are connected to each other as a network.

How to convert all LINES to a Pressure Pipe Network ?

2
AutoLISP (Vanilla / Visual) / Re: Entmake Text with Arrow
« Last post by efernal on Today at 07:15:26 AM »
Code - Auto/Visual Lisp: [Select]
  1. ;; please, subst this
  2.  
  3. (SETQ di  (/ (* g:tarrow:hf 0.45) 0.5) 
  4.                    nm  (TRANS '(0.0 0.0 1.0) 1 0 T)
  5.                    a   (ANGLE p1 p2)
  6.                    str ""
  7.                    p11 (POLAR (POLAR p1 (ANGLE p1 p2) (/ (DISTANCE p1 p2) 2.0)) (- a (* PI 0.5)) (/ g:tarrow:hf 5.0))
  8.              )
  9.  
  10. ;;for this
  11.  
  12. (SETQ di  (/ (* g:tarrow:hf 0.45) 0.5)
  13.                    nm  (TRANS '(0.0 0.0 1.0) 1 0 T)
  14.                    a   (ANGLE p1 p2)
  15.                    str ""
  16.                    p11 (IF (AND (> a (* PI 0.5)) (< a (* PI 1.5)))
  17.                          (POLAR (POLAR p1 (ANGLE p1 p2) (/ (DISTANCE p1 p2) 2.0)) (+ a (* PI 0.5)) (/ g:tarrow:hf 5.0))
  18.                          (POLAR (POLAR p1 (ANGLE p1 p2) (/ (DISTANCE p1 p2) 2.0)) (- a (* PI 0.5)) (/ g:tarrow:hf 5.0))
  19.                        )
  20.              )
3
AutoLISP (Vanilla / Visual) / Re: Entmake Text with Arrow
« Last post by efernal on Today at 07:08:04 AM »
Ok, done...
Code - Auto/Visual Lisp: [Select]
  1. (DEFUN c:tarrow (/ p1 p2 di nm a str hf p11)
  2.   (IF (OR (NOT g:tarrow:hf) (NOT (NUMBERP g:tarrow:hf)) (NOT (> g:tarrow:hf 0.0)))
  3.     (SETQ g:tarrow:hf 5.0)
  4.   )
  5.   (INITGET 6)
  6.   (SETQ hf (GETREAL (STRCAT "\n-> Altura da fonte < " (RTOS g:tarrow:hf 2 2) " > : "))) ; FONT HEIGHT = altura da fonte
  7.   (IF (> hf 0.0)
  8.     (SETQ g:tarrow:hf hf)
  9.   )
  10.   (WHILE (SETQ p1 (GETPOINT "\n-> Clique no primeiro ponto :")) ; FIRST POINT = Give a first point
  11.     (IF (SETQ p2 (GETPOINT p1 "\r-> Clique no ponto final :     ")) ; SECOND POINT = Now give me a second point
  12.       (PROGN (SETQ di  (/ (* g:tarrow:hf 0.45) 0.5) 
  13.                    nm  (TRANS '(0.0 0.0 1.0) 1 0 T)
  14.                    a   (ANGLE p1 p2)
  15.                    str ""
  16.                    p11 (POLAR (POLAR p1 (ANGLE p1 p2) (/ (DISTANCE p1 p2) 2.0)) (- a (* PI 0.5)) (/ g:tarrow:hf 5.0))
  17.              )
  18.              (ENTMAKE (LIST (CONS 0 "LWPOLYLINE")
  19.                             (CONS 100 "AcDbEntity")
  20.                             (CONS 100 "AcDbPolyline")
  21.                             (CONS 90 3)
  22.                             (CONS 70 0)
  23.                             (CONS 8 "Texto e Seta") ; Text and arrow
  24.                             (CONS 10 (TRANS p2 1 nm))
  25.                             (CONS 40 0.0)
  26.                             (CONS 41 (/ di 2.0))
  27.                             (CONS 62 21)
  28.                             (CONS 10 (TRANS (POLAR p2 (ANGLE p2 p1) di) 1 nm))
  29.                             (CONS 10 (TRANS p1 1 nm))
  30.                             (CONS 210 nm)
  31.                       )
  32.              )
  33.              (WHILE (AND (NOT (> (STRLEN str) 0)) (NOT (WCMATCH str "*#*@*")) (NOT (WCMATCH str "*@*#*")))
  34.                (SETQ str (GETSTRING "\r-> Texto a escrever : " T)) ; Give me a string
  35.              )
  36.              (ENTMAKE (LIST (CONS 0 "TEXT")
  37.                             (CONS 100 "AcDbEntity")
  38.                             (CONS 100 "AcDbText")
  39.                             (CONS 10 (LIST 0. 0. 0.))
  40.                             (CONS 40 g:tarrow:hf)
  41.                             (CONS 8 "Texto e Seta") ; Text and arrow
  42.                             (CONS 62 1)
  43.                             (CONS 1 str)
  44.                             (CONS 50
  45.                                   (IF (MINUSP (COS a))
  46.                                     (+ PI a)
  47.                                     a
  48.                                   )
  49.                             )
  50.                             (CONS 72 1)
  51.                             (CONS 11 p11)
  52.                             (CONS 73 3)
  53.                       )
  54.              )
  55.       )
  56.     )
  57.   )
  58.   (PRINC)
  59. )
  60.  ;|«Visual LISP© Format Options»
  61. (140 2 40 2 nil "end of " 100 9 2 1 0 nil nil nil T)
  62. ;*** DO NOT add text below the comment! ***|;
4
First things First / Modifying function Tostring
« Last post by Giuseppe Beatrice on Today at 05:24:58 AM »
The Tostring function, prepared by MP in https://www.theswamp.org/index.php?topic=4814.0 has been very helpful for me in the preparation of lines of text for saving files containing lists with variable values to be recovered for later uses.
However, I found that saving real numbers of type 3.0 or 3. with a decimal part equal to 0 always resulted in a string "3"; this behavior is due to the dimzin system variable, which automatically suppresses the zeros, so I made a small change to the function itself.
Code: [Select]
(defun ToString    (x / typex)
  ;;  convert item to a string, if x is a real use
  ;;  the highest possible precision, if x is a
  ;;  string double quote it, if x is a list process
  ;;  each item in the list appropriatel, otherwise
  ;;  just hammer item with vl-princ-to-string
  ;;   (ToString 1.0 )
  (cond   ;;  it's a string, return it double quoted
   ((eq 'str (setq typex (type x))) (strcat "\"" x "\""))
   ;; it's a real, with decimal
   ((and (eq 'real typex) (= (- x (fix x)) 0.0)); reali con parte decimale nulla
    (setq oldsys# (getvar 'dimzin))
    (setvar 'dimzin 1); variabile sistema dimzin a 1 consente di non sopprimere gli zeri finali nelle quote decimali
    (setq res$ (rtos x 2 1)) ;_  numeri reali coincidenti con interi trasformati in stringhe con un solo decimale
    (setvar 'dimzin oldsys#)
    res$)
   ;;  it's a real, covert to the highest possible
   ;;  resolution string equivalent
   ((eq 'real typex)
    (rtos x
          2
          (if (zerop (- x (fix x)))
       1
       15)))
   ;;  it's a list
   ((eq 'list typex)
    (if (vl-list-length x)
      ;;  it's a normal list
      (strcat (chr 40)
         (ToString (car x))
         (apply 'strcat (mapcar '(lambda (x) (strcat " " (ToString x))) (cdr x)))
         (chr 41))
      ;;  it's a dotted pair
      (strcat (chr 40) (ToString (car x)) " . " (ToString (cdr x)) (chr 41))))
   ;;  hammer down on everything else
   ((vl-princ-to-string x))))
5
AutoLISP (Vanilla / Visual) / i want lisp for change linetype in block
« Last post by bumroong on November 16, 2018, 11:25:55 PM »
 i want lisp for change linetype in block by pick block and choose linetype table
thank for helpfull
6
AutoLISP (Vanilla / Visual) / there is issue i want lisp for change linetype in block
« Last post by bumroong on November 16, 2018, 11:23:18 PM »
 i want lisp for change linetype in block by pick block and choose linetype table
thank for helpfull
7
AutoLISP (Vanilla / Visual) / Re: If statement. Layer gets made but color won't set.
« Last post by kdub on November 16, 2018, 06:55:47 PM »
Does this work for you.

Code - Auto/Visual Lisp: [Select]
  1.  
  2. (setq OldLayerName "AAC"
  3.       NewLayerName "ABCD"
  4.       LayerColor   "136"
  5.       fm136	   (ssget "_X" (list (cons 8 OldLayerName)))
  6. )
  7.  
  8. (if (not (= (atoi LayerColor)
  9. 	    (cdr (assoc 62 (tblsearch "LAYER" NewLayerName)))
  10. 	 )
  11.     )
  12.   (command "._Layer" "_Make" NewLayerName "_Color" LayerColor "" "")
  13. )
  14. (if fm136
  15.   (command "_chprop" fm136 "" "_la" NewLayerName "")
  16. )
  17.  
8
AutoLISP (Vanilla / Visual) / Re: If statement. Layer gets made but color won't set.
« Last post by jlogan02 on November 16, 2018, 05:55:45 PM »
Edit: All of this works fine but my approach is wonky. The FiberMgt layers will only exist on a building equipment plan. There's another portion of the code (not shown) which deals with changing objects from their bylayer color to a construction/rev color. Those changes occur on the building equipment plan and a multitude of schematics, wiring diagrams and etc. As it stands now the code below will create the FiberMgt layer on every type of drawing if the layer doesn't exist.

I don't want that. I want it to do everything it's doing just not on every type of drawing.
Title Block is attributed - Could I...

(if (attribute "titleline4" reads Building Plan
(do the deed

or

(if (block FM insert exists
(do the deed

or is there something more I can add to what I have?


End Edit:

Never mind

Using Chprop doesn't require the "P" in it. Removed it and all is fine.

Code - Auto/Visual Lisp: [Select]
  1. (if (tblsearch "LAYER" "FiberMgt_136") ;Check if the layer exists
  3.    (setq fm136 (ssget "x" '((8 . "FiberMgt_56"))))
  4.    (command "_chprop" fm136 "" "la" "FiberMgt_136" "" (command)(command))[i]Removed "P" here[/i]
  5. ) ;End if progn?
  7.    (setq fm136 (ssget "x" '((8 . "FiberMgt_56"))))
  8.    (command "._Layer" "Make" "FiberMgt_136" "_Color" "136" "" "" (command)(command))
  9.    (command "_chprop" fm136 "" "la" "FiberMgt_136" "" (command)(command))[i]Removed "P" here[/i]
  10.  ) ;End if progn
  11.  ) ;End of if
9
CAD General / Re: LIST command odd behavior
« Last post by kdub on November 16, 2018, 05:44:49 PM »
What happens when you try the following commmands ??

LIST
LI
LS


If LIST and LS work
and LI does not, I'd suggest that the LI command has been defined elsewhere.


The prompt you get about
Quote
Highlight Selected Layers <Yes>/No:
Do you recall seeing this elsewhere ??

note
The ! prefix does not evaluate command aliases from the .PGP file.
That is why the !LI is returning nil.
10
AutoLISP (Vanilla / Visual) / Re: Entmake Text with Arrow
« Last post by Dilan on November 16, 2018, 05:37:24 PM »
Quote from: efernal on November 16, 2018, 12:50:39 PM
Better...
Code - Auto/Visual Lisp: [Select]
  1. (DEFUN c:tarrow (/ p1 p2 di nm a str)
  2.   (IF (OR (NOT g:tarrow:hf) (NOT (NUMBERP g:tarrow:hf)) (NOT (> g:tarrow:hf 0.0)))
  3.     (SETQ g:tarrow:hf 5.0)
  4.   )
  5.   (INITGET 6)
  6.   (SETQ hf (GETREAL (STRCAT "\n-> Altura da fonte < " (RTOS g:tarrow:hf 2 2) " > : "))) ; FONT HEIGHT
  7.   (IF (> hf 0.0)
  8.     (SETQ g:tarrow:hf hf)
  9.   )
  10.   (WHILE (SETQ p1 (GETPOINT "\n-> Clique no primeiro ponto :")) ; FIRST POINT
  11.     (IF (SETQ p2 (GETPOINT p1 "\r-> Clique no ponto final :     ")) ; SECOND POINT
  12.       (PROGN (SETQ di  (/ (* g:tarrow:hf 0.45) 0.5)
  13.                    nm  (TRANS '(0.0 0.0 1.0) 1 0 T)
  14.                    a   (ANGLE p1 p2)
  15.                    str ""
  16.              )
  17.              (ENTMAKE (LIST (CONS 0 "LWPOLYLINE")
  18.                             (CONS 100 "AcDbEntity")
  19.                             (CONS 100 "AcDbPolyline")
  20.                             (CONS 90 3)
  21.                             (CONS 70 0)
  22.                             (CONS 8 "Texto e Seta")
  23.                             (CONS 10 (TRANS p2 1 nm))
  24.                             (CONS 40 0.0)
  25.                             (CONS 41 (/ di 2.0))
  26.                             (CONS 62 21)
  27.                             (CONS 10 (TRANS (POLAR p2 (ANGLE p2 p1) di) 1 nm))
  28.                             (CONS 10 (TRANS p1 1 nm))
  29.                             (CONS 210 nm)
  30.                       )
  31.              )
  32.              (WHILE (AND (NOT (> (STRLEN str) 0)) (NOT (WCMATCH str "*#*@*")) (NOT (WCMATCH str "*@*#*")))
  33.                (SETQ str (GETSTRING "\r-> Texto a escrever : " T)) ; GIVE ME A STRING
  34.              )
  35.              (ENTMAKE (LIST (CONS 0 "TEXT")
  36.                             (CONS 100 "AcDbEntity")
  37.                             (CONS 100 "AcDbText")
  38.                             (CONS 10 (LIST 0. 0. 0.))
  39.                             (CONS 40 g:tarrow:hf)
  40.                             (CONS 8 "Texto e Seta")
  41.                             (CONS 62 1)
  42.                             (CONS 1 str)
  43.                             (CONS 50
  44.                                   (IF (MINUSP (COS a))
  45.                                     (+ PI a)
  46.                                     a
  47.                                   )
  48.                             )
  49.                             (CONS 72 1)
  50.                             (CONS 11 (LIST (/ (+ (CAR p1) (CAR p2)) 2.0) (/ (+ (CADR p1) (CADR p2)) 2.0) 0.0))
  51.                             (CONS 73 1)
  52.                       )
  53.              )
  54.       )
  55.     )
  56.   )
  57.   (PRINC)
  58. )
But the text is also above the arrow and not under it.
Is it possible to do it like in the picture?
Pages: [1] 2 3 ... 10