mhy3sx Posted Thursday at 03:45 PM Posted Thursday at 03:45 PM I am searching for a lisp code to draw a section line like the test.dwg. 1) Select 2 points for the length of the section 2) Pick a point for the direction of the section 3) Draw section line with the arrows and ask for the section letter for exampl A,B Thanks TEST.dwg Quote
mhy3sx Posted Thursday at 06:12 PM Author Posted Thursday at 06:12 PM (defun C:SECTIONLINE ( / pt1 pt2 dirpt baseAngle dirAngle angle arrowLen arrowAng secLetter txtpt angleDeg p1 p2 ) (setq arrowLen 10.0) (setq arrowAng (/ pi 6.0)) (setq pt1 (getpoint "\nSelect first point of section line: ")) (if (not (and pt1 (listp pt1))) (progn (princ "\nCanceled or invalid first point.") (quit)) ) (setq pt2 (getpoint pt1 "\nSelect second point of section line: ")) (if (not (and pt2 (listp pt2))) (progn (princ "\nCanceled or invalid second point.") (quit)) ) (setq dirpt (getpoint "\nPick a point to define section direction: ")) (if (not (and dirpt (listp dirpt))) (progn (princ "\nCanceled or invalid direction point.") (quit)) ) (setq baseAngle (angle pt1 pt2)) (setq dirAngle (angle pt1 dirpt)) (setq angle (if (< (abs (- baseAngle dirAngle)) (/ pi 2.0)) baseAngle (+ baseAngle pi))) (command "._LINE" "_non" pt1 "_non" pt2 "") (setq p1 (polar pt1 (+ angle arrowAng) arrowLen)) (setq p2 (polar pt1 (- angle arrowAng) arrowLen)) (command "._LINE" "_non" pt1 "_non" p1 "") (command "._LINE" "_non" pt1 "_non" p2 "") (setq p1 (polar pt2 (+ angle arrowAng) arrowLen)) (setq p2 (polar pt2 (- angle arrowAng) arrowLen)) (command "._LINE" "_non" pt2 "_non" p1 "") (command "._LINE" "_non" pt2 "_non" p2 "") (setq secLetter (getstring T "\nEnter section letter (e.g., A, B): ")) (if (= secLetter "") (setq secLetter "A")) (if (and (listp pt1) (listp pt2)) (progn (setq txtpt (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pt1 pt2)) (setq angleDeg (* 180.0 (/ angle pi))) (command "._TEXT" "_non" txtpt 2.5 angleDeg (strcat secLetter "-" secLetter)) ) (princ "\nText not placed due to invalid points.") ) (princ "\nSection line created successfully.") (princ) ) I have this error (I use ZWCAD) Command: SECTIONLINE Select first point of section line: Select second point of section line: Pick a point to define section direction: Error: undefined function - nil Thanks Quote
marko_ribar Posted Thursday at 07:09 PM Posted Thursday at 07:09 PM (edited) You haven't defined "arrowAng" variable and you are using it in (polar) function... Sorry, my mistake - you defined it firstly... [EDIT : You should changle variable "angle" to something different like "ang" as (angle) is AutoLISP function and then you should localize "ang" in main (defun) instead of "angle"...] Edited Thursday at 09:03 PM by marko_ribar 1 1 Quote
mhy3sx Posted Friday at 09:31 AM Author Posted Friday at 09:31 AM Hi Bigal I try but I have problem with the angles. In my template the units set (mapcar 'setvar (list 'aunits 'auprec 'angdir 'angbase 'lunits 'luprec 'insunits ) (list 2 4 1 (/ pi 2) 2 3 6)) ; for ZWCAD (defun C:SECTIONLINE ( / pt1 pt2 dirpt baseAngle dirAngle ang arrowBase arrowHeight secLetter txtpt1 txtpt2 angleDeg p1 p2 p3 offset letterOffset) (command "._STYLE" "Section" "Arial" 0.0 1.4 0 "N" "N" "N") (if (= (tblsearch "layer" "Section") nil) (vl-cmdf "_layer" "_m" "Section" "_c" "10" "" "_lw" "0.05" "" "") ) (setvar "clayer" "Section") (setq arrowBase 0.69) (setq arrowHeight 0.27) (setq offset 0.11) (setq letterOffset 0.31) (setq pt1 (getpoint "\nSelect first point of section line: ")) (if (not (and pt1 (listp pt1))) (progn (princ "\nCanceled or invalid first point.") (quit)) ) (setq pt2 (getpoint pt1 "\nSelect second point of section line: ")) (if (not (and pt2 (listp pt2))) (progn (princ "\nCanceled or invalid second point.") (quit)) ) (setq dirpt (getpoint "\nPick a point to define section direction: ")) (if (not (and dirpt (listp dirpt))) (progn (princ "\nCanceled or invalid direction point.") (quit)) ) (setq secLetter (getstring T "\nEnter section letter (e.g., A, B): ")) (if (= secLetter "") (setq secLetter "A")) (setq baseAngle (angle pt1 pt2)) (setq dirAngle (angle pt1 dirpt)) (setq ang (if (< (abs (- baseAngle dirAngle)) (/ pi 2.0)) dirAngle (+ dirAngle pi))) (command "._LINE" "_non" pt1 "_non" pt2 "") (setq p1 (polar pt1 baseAngle offset) (setq p2 (polar p1 (+ baseAngle (/ pi 2.0)) (/ arrowBase 2.0))) (setq p3 (polar p1 (- baseAngle (/ pi 2.0)) (/ arrowBase 2.0))) (command "._PLINE" "_non" p2 "_non" (polar p1 ang arrowHeight) "_non" p3 "_non" p2 "") (command "._HATCH" "SOLID" "_L" "" "") (setq txtpt1 (polar pt1 ang letterOffset)) (setq angleDeg (* 400.0 (/ baseAngle pi))) (command "._TEXT" "J" "MC" "_non" txtpt1 0.27 angleDeg secLetter) (setq p1 (polar pt2 (- baseAngle pi) offset)) (setq p2 (polar p1 (+ baseAngle (/ pi 2.0)) (/ arrowBase 2.0))) (setq p3 (polar p1 (- baseAngle (/ pi 2.0)) (/ arrowBase 2.0))) (command "._PLINE" "_non" p2 "_non" (polar p1 ang arrowHeight) "_non" p3 "_non" p2 "") (command "._HATCH" "SOLID" "_L" "" "") (setq txtpt2 (polar pt2 ang letterOffset)) (command "._TEXT" "J" "MC" "_non" txtpt2 0.27 angleDeg secLetter) (princ "\nSection line created successfully.") (princ) ) Thanks Quote
BIGAL Posted Saturday at 12:00 AM Posted Saturday at 12:00 AM Not sure why you are asking me about units, you could try making the variable names "Aunits". with double quotes, works in Bricscad, else you can use a foreach loop but I would use car & cadr in the loop, (list (list "aunits" 2)("list 'auprec"4)(......)) Just a suggestion for labelling, the character "A" is (chr 65) (chr x) so you can start with a number and each time you run the section lisp it will add 1 to the x, this will do up to 26. You can save the value of X by using ldata so when dwg is opened again you still have next value and can display that in a prompt. So Enter will give next value. Yes there is code for AA AB etc. Why not a dynamic block then can have a single stretch parameter based on the two pick points. 1 Quote
mhupp Posted Saturday at 12:51 AM Posted Saturday at 12:51 AM 48 minutes ago, BIGAL said: Why not a dynamic block then They are using ZWCAD. and dynamic blocks are a propriety feature of AutoDesk. (or at least were not fully functional when i was using BricsCAD might be a feature now) Quote
BIGAL Posted yesterday at 12:03 AM Posted yesterday at 12:03 AM There is parametrics in Bricscad, similar to dynamic block in Acad. Here is a sample think of the two circles as the section arrow details. Can add attributes etc. I just made a block with gap set to 100, then did Bedit and typed PARAMETRICSTRETCH, follow prompts just select one side. Can add a lisp pick 2 points for alignment and reset length. section.dwg Quote
mhy3sx Posted 19 hours ago Author Posted 19 hours ago Hi BIGAL , PARAMETRICSTRETCH not exist in ZWCAD Thanks Quote
mhy3sx Posted 18 hours ago Author Posted 18 hours ago Now the arrows is correct. The only problem is the angle of the text is not in all direction in correct angle !!! I want the text to have the same directions with the arrows (defun C:SECTIONLINE ( / pt1 pt2 dirpt secLet baseAngle dx dy cross normalAngle arrowBase arrowHeight arrowOffset offset letterOffset arrow1Base arrow2Base center1 center2 txtpt1 txtpt2 angleGrad) (setq arrowBase 0.69) (setq arrowHeight 0.27) (setq arrowOffset 0.345) (setq offset 0.11) (setq letterOffset 0.42) (command "._STYLE" "Section" "Arial" 0.0 1.4 0 "N" "N" "N") (if (not (tblsearch "layer" "Section")) (command "_-layer" "make" "Section" "color" "10" "" "lw" "0.05" "" "") ) (setvar "clayer" "Section") (setq pt1 (getpoint "\nSelect first point of section line: ")) (if (not pt1) (progn (princ "\nCanceled.") (exit))) (setq pt2 (getpoint pt1 "\nSelect second point of section line: ")) (if (not pt2) (progn (princ "\nCanceled.") (exit))) (setq dirpt (getpoint "\nPick a point to define section direction: ")) (if (not dirpt) (progn (princ "\nCanceled.") (exit))) (setq secLet (getstring T "\nEnter section letter (e.g., A, B): ")) (if (= secLet "") (setq secLet "A")) (setq baseAngle (angle pt1 pt2)) (setq dx (- (car pt2) (car pt1))) (setq dy (- (cadr pt2) (cadr pt1))) (setq cross (- (* dx (- (cadr dirpt) (cadr pt1))) (* dy (- (car dirpt) (car pt1))))) (setq normalAngle (if (> cross 0) (+ baseAngle (/ pi 2)) (- baseAngle (/ pi 2)) )) (command "._LINE" "_non" pt1 "_non" pt2 "") (defun drawArrow (basePoint / center p1 p2 tip) (setq center (polar basePoint normalAngle offset)) (setq p1 (polar center (+ baseAngle pi) (/ arrowBase 2.0))) (setq p2 (polar center baseAngle (/ arrowBase 2.0))) (setq tip (polar center normalAngle arrowHeight)) (command "._PLINE" "_non" p1 "_non" tip "_non" p2 "_non" p1 "") (command "._HATCH" "SOLID" "_L" "" "") center ) (setq arrow1Base (polar pt1 baseAngle arrowOffset)) (setq center1 (drawArrow arrow1Base)) (setq arrow2Base (polar pt2 (+ baseAngle pi) arrowOffset)) (setq center2 (drawArrow arrow2Base)) (defun fix-angle (a) (setq grad (* 200.0 (/ a pi))) (if (or (> grad 100) (< grad -100)) (+ a pi) a ) ) (setq txtAngle1 (fix-angle (+ normalAngle pi))) (setq angleGrad1 (* 200.0 (/ txtAngle1 pi))) (setq txtpt1 (polar center1 (+ normalAngle pi) letterOffset)) (setq txtpt2 (polar center2 (+ normalAngle pi) letterOffset)) (command "._TEXT" "J" "MC" "_non" txtpt1 0.27 angleGrad1 secLet) (command "._TEXT" "J" "MC" "_non" txtpt2 0.27 angleGrad1 secLet) (princ "\nSection line created successfully.") (princ) ) Thanks Quote
BIGAL Posted 11 hours ago Posted 11 hours ago (edited) @mhy3sx Does parametrics exist in ZWCAD ? If so what happens if you edit the example I posted just use Bedit and remove the circles and add your section mark details and save block edits. There should be a stretch option for parametrics. These are blocks and matching code just does a mirror. Just an example of choose type of mark using a pop menu. Edited 11 hours ago by BIGAL Quote
Saxlle Posted 3 hours ago Posted 3 hours ago (edited) @mhy3sx Try the following code (it work the same as yours, but you can see the part of code for "letter" roration for your part of code, you can get a text angle when creating an arrow): (prompt "\nTo run a LISP type: SECLINE") (princ) (defun c:SECLINE ( / old_osmode flag alphabet dist arrow_base arrow_height text_height spt ept output base_pt ang off_pt arrow_ang arrow_fpt arrow_spt arrow_midpt arrow_tpt letter_ang letter_inspt answ) (setq old_osmode (getvar 'osmode)) (setvar 'osmode 0) (setq flag T alphabet (list "A B C D E F G H I J K L M N O P Q R S T U V W X Y Z") ;; Alphabet UPPERCASE letters dist 0.11 ;; offset distance from section line arrow_base 0.69 arrow_height 0.27 text_height 0.27 ) (if (not (tblsearch "layer" "Section")) (command-s "_layer" "_m" "Section" "_c" "10" "" "_lw" "0.05" "" "") (setvar 'clayer "Section") ) (while (= flag T) (setq spt (getpoint "\nPick the first point:") ept (getpoint spt "\nPick the second point:") ) (command-s "_UNDO" "begin") (entmake (list (cons 0 "LINE") (cons 100 "AcDbEntity") (cons 100 "AcDbLine") (cons 8 (getvar 'clayer)) (cons 10 spt) (cons 11 ept))) (initget 1 (car alphabet)) (setq output (getkword (strcat "\nChoose a letter from the list [" (vl-string-translate " " "/" (car alphabet)) "]: "))) (setq base_pt ept ang (angle spt ept) off_pt (getpoint base_pt "\nPick the side to get an arrow and letter") arrow_ang (angle base_pt off_pt) ) ;; 1. arrow and text (setq arrow_fpt (polar base_pt arrow_ang dist) arrow_spt (polar arrow_fpt ang (- arrow_base)) arrow_midpt (mapcar '* (mapcar '+ arrow_fpt arrow_spt) (list 0.50 0.50)) arrow_tpt (polar arrow_midpt arrow_ang arrow_height) letter_ang (angle arrow_fpt base_pt) letter_inspt (polar arrow_midpt letter_ang (* arrow_height 1.15)) letter_ang (+ pi (/ pi 2) arrow_ang) ) (entmake (list (cons 0 "SOLID") (cons 100 "AcDbEntity") (cons 100 "AcDbTrace") (cons 10 arrow_fpt) (cons 11 arrow_spt) (cons 8 (getvar 'clayer)) (cons 12 arrow_tpt) (cons 13 arrow_tpt))) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 10 letter_inspt) (cons 8 (getvar 'clayer)) (cons 40 text_height) (cons 1 output) (cons 50 letter_ang) (cons 72 1) (cons 73 2) (cons 11 letter_inspt))) ;; 2. arrow and text (setq base_pt spt ang (angle ept spt) arrow_fpt (polar base_pt arrow_ang dist) arrow_spt (polar arrow_fpt ang (- arrow_base)) arrow_midpt (mapcar '* (mapcar '+ arrow_fpt arrow_spt) (list 0.50 0.50)) arrow_tpt (polar arrow_midpt arrow_ang arrow_height) letter_ang (angle arrow_fpt base_pt) letter_inspt (polar arrow_midpt letter_ang (* arrow_height 1.15)) letter_ang (+ pi (/ pi 2) arrow_ang) ) (entmake (list (cons 0 "SOLID") (cons 100 "AcDbEntity") (cons 100 "AcDbTrace") (cons 10 arrow_fpt) (cons 11 arrow_spt) (cons 8 (getvar 'clayer)) (cons 12 arrow_tpt) (cons 13 arrow_tpt))) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 10 letter_inspt) (cons 8 (getvar 'clayer)) (cons 40 text_height) (cons 1 output) (cons 50 letter_ang) (cons 72 1) (cons 73 2) (cons 11 letter_inspt))) (command-s "_UNDO" "end") (initget 1 "Yes No Undo") (setq answ (getkword "\nDo you want to continue or Undo? [Yes/No/Undo]")) (cond ((= answ "No") (setq flag nil) ) ((= answ "Undo") (command-s "_UNDO" "") ) ) (princ) ) (setvar 'osmode old_osmode) (prompt "\nDrawing section lines are done!") (princ) ) This is the short video example. SectionLine.mp4 Best regards. Edited 3 hours ago by Saxlle Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.